Count + Color

Halli hallo
ich hätte da zwei ein Problem beim Coden.
1) Ich will die Zellen in einem Sheet("Tabelle1") ansprechen ("B4:B:25000") da diese einen Farbkode haben, sprich eine Zahl von 1-6. Je nach Zahl in der Spalte sollen die Zeilen eingefärbt werden.
Würde bedeuten in B2384 steht eine 1, sollte die gesamte Zeile A-Z rot eingefäbrt werden. Wie mache ich das?
Ich müsste mit Dim arbeiten und einen Ansatz habe ich auch schon, nur leider befindet der sich auf der Arbeit. Will ja nicht jede Zeile einzeln ansprechen mit If Else - inferior.color etc.
2) Kurzgefasst: Wie zähle ich die Spalten, sodass quasi alle ausgefüllten Spalten ein Border bekommen.
Mir geht es hauptsächlich um das zählen und wie ich das dann ausführe. Irgendwas mit
n = Worksheets("Tabelle1").Columns.Count
und dann um die Border herzustellen Range("A1:Zn")
Ich hoffe ihr versteht was ich meine.
(Ich bin beim Bund und ihr würdet mir wirklich helfen wenn das klappen könnte, würde meine Arbeit um etliche Stunden ersparen.)
Ganz viele liebe Grüße ~

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Count + Color

27.04.2009 16:52:57

Andi

AW: Count + Color

27.04.2009 17:01:28

Tino

Hallo,
vielleicht geht es so, getestet unter xl2007.

Option Explicit
Function FarbCode(LWert As Long) As Integer
 'Farben entsprechend anpassen. 
    Select Case LWert
     Case 1: FarbCode = 3
     Case 2: FarbCode = 18
     Case 3: FarbCode = 6
     Case 4: FarbCode = 7
     Case 5: FarbCode = 8
     Case 6: FarbCode = 12
    End Select
End Function


Sub Test()
Dim Bereich As Range, MerkSort As Range
Dim GesBereich As Range, FZellen As Range
Dim A As Long
Dim iCalc As Integer
Set Bereich = Range("B4", Cells(Rows.Count, 2).End(xlUp))
Set Bereich = Bereich.Offset(0, Columns.Count - Bereich.Column)
Set MerkSort = Bereich.Offset(0, -1)
Set GesBereich = Range("A4", Cells(Rows.Count, Columns.Count))

With Application
 iCalc = .Calculation
 .ScreenUpdating = False
 .EnableEvents = False
 .Calculation = xlCalculationManual
    MerkSort.FormulaR1C1 = "=ROW()"
    GesBereich.Sort GesBereich(1, 2), xlAscending, , , , , , xlNo
    
        For A = 1 To 6
             Bereich.FormulaR1C1 = "=IF(RC2=" & A & ",0,"""")"
             
             If .WorksheetFunction.CountIf(Bereich, 0) > 0 Then
              Set FZellen = Bereich.SpecialCells(xlCellTypeFormulas, 1)
              Range(FZellen.Offset(0, -(Columns.Count - 2)), FZellen.Offset(0, -(Columns.Count - 26))).Interior.ColorIndex = FarbCode(A)
             End If
             
             
        Next A
    
    GesBereich.Sort MerkSort(1, 1), xlAscending, , , , , , xlNo
    
    Columns(Columns.Count).Delete
    Columns(Columns.Count - 1).Delete
 .ScreenUpdating = True
 .EnableEvents = True
 .Calculation = iCalc
End With
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread