ich würde gerne folgendes hinkriegen:
in einem Prozedurablauf soll ein Array mit Werten bestückt werden (Zahlen für ColorIndex), die anschließend "auf einen Schlag" einem dazu passenden Zellbereich "übergestülpt" wird. Mein (nicht funktionierender) Code (Button "Schriftfarbe einbringen funktioniert leider nicht")
Das Einbringen von Zellwerten mit der analogen Vorgehensweise (Button "Werte einbringen funktioniert") läuft einwandfrei.
Der Umweg, die Arraywerte via Schleife Stück für Stück auf den Zellbereich zu übertragen (Button "Schriftfarbe funktioniert aber unschön") läuft problemlos, ist aber zeitintensiver.
Kennt jemand von euch einen Weg, die Arraywerte direkt auf die Schriftfarbe der Zellen zu übertragen?
Danke schon mal für eure Unterstützung.
Gruß Ludwig
statt myarray würde ich in diesem Fall gleich die 42 nehmen Der Code soll aber sicher nur die Vorgehensweise verdeutlichen, es würde ja nur Sinn machen, wenn da unterschiedliche Zahlen drin stehen.
Da muss ich Dich leider enttäuschen. wenn nicht jede Zeile eine andere Farbe hat könntest Du höchstens versuchen, jeweils einzelne Bereiche gleicher Farbe "auf einen Schlag" zu behandeln.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Zitat:Der Code soll aber sicher nur die Vorgehensweise verdeutlichen,
du hast mich durchschaut :19: . (Sorry, so viel Zeit für einen Kalauer muss schon sein...).
Ernsthaft:
Danke für die Rückmeldung. Ich hatte schon befürchtet, dass mein Plan nicht aufgeht. Deine Einschätzung bringt mich da weiter. Übrigens auch deine Idee, das blockweise anzugehen (wir reden im konkreten Fall von zwei bis drei Farben); ich werde das gleich mal versuchen.
Gruß Ludwig
' Range("A1").Cells(1, 1).Resize(UBound(myarray, 1), 1).Font.ColorIndex = myarray(10, 1) For i = LBound(myarray, 1) To UBound(myarray, 1) Range("Testbereich").Cells(i).Font.ColorIndex = myarray(i, 1) Next i End Sub
@ Stefan, deinen Vorschlag habe ich auch getestet; er entspricht wohl meinem "Schriftfarbe funktioniert aber unschön"-Knopf.
Ich hab alle Prozeduren mal "unter Stress gesetzt" (1.000 x Durchlauf) und die Zeiten gestoppt:
Stefan, du liegst (bei meiner Rechnergeschwindigkeit) mit 10s gleichauf mit meiner "unschönen".
Die Wunschprodezur, die leider nur auf Werte anwendbar ist, läge bei <1 s.
Der von mir oben beschriebene Kompromissweg (inspiriert von Andre) braucht 4 s.
Verbesserungsvorschläge sind willkommen.
Danke und
Gruß Ludwig
die produktive Variante läuft dann aber ohne Schleife:
Code:
Sub KompromissSubSchriftfarbeAS()
Dim myarray As Variant
Dim i As Integer, k As Integer, l As Integer
Dim myRange As Range
Dim Zeit1 As Date, Zeit2 As Date
ReDim myarray(1 To 1000, 1 To 1)
For i = 1 To 1000
Select Case i Mod 10
Case 1, 4, 9
myarray(i, 1) = 20
Case 2, 3, 7
myarray(i, 1) = 30
Case Else
myarray(i, 1) = 42
End Select
Next i
Set myRange = Range("TestBereich").Resize(1000, 1).Offset(, -1)
myRange.Cells(1, 1).Resize(UBound(myarray), 1).Value = myarray
Set myRange = myRange.Offset(-1) '.Resize(Range("TestBereich").Rows.Count + 1)
myRange.Offset(-1, 1).Cells(1, 1).Value = "Spaltenkopf"
Application.ScreenUpdating = False
myRange.Offset(, 1).Select
'Range("TestBereich").Select
Zeit1 = Now
k = 20
myRange.AutoFilter Field:=1, Criteria1:=k
Selection.Font.ColorIndex = k
k = 30
myRange.AutoFilter Field:=1, Criteria1:=k
Selection.Font.ColorIndex = k
k = 42
myRange.AutoFilter Field:=1, Criteria1:=k
Selection.Font.ColorIndex = k
myRange.AutoFilter
Zeit2 = Now
myRange.ClearContents
Application.ScreenUpdating = True
MsgBox (Zeit2 - Zeit1) * 24 * 3600 & " s"
End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
da hast du recht.
Die Schleife ist nicht nötig; die habe ich für meinen "Stress-Test" eingebaut (1000 x Durchlauf - 999 davon als Zugabe - für den Vergleich der diskutierten Herangehensweisen).
Danke und Gruß Ludwig