AW: Fast Perfekt
20.12.2016 14:16:35
Michael
Hallo!
Hier meine adaptierte Bsp-Datei: https://www.herber.de/bbs/user/110124.xlsm
Der Code
Sub b()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1") 'Quell-Blatt
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle4") 'Ziel-Blatt
Dim Texte As Range, C As Range, a, t As String
Dim i As Long, j As Long, k As Long
WsZ.Columns(1).Clear 'Zellen in Spalte 1 im Ziel-Blatt löschen
With WsQ
'Quell-Blatt "verwendeten Bereich" durchgehen
Set Texte = .UsedRange
ReDim a(0 To Texte.Cells.Count - 1)
For Each C In Texte
For i = 1 To Len(C)
With C.Characters(i, 1).Font
If .Name = "Arial" And .Color = RGB(255, 0, 0) Then
t = t & C.Characters(i, 1).Text
End If
End With
Next i
If Len(t) > 0 Then
a(j) = t: j = j + 1: t = vbNullString: k = k + 1
End If
Next C
ReDim Preserve a(LBound(a) To k - 1)
WsZ.Range("A1").Resize(k, 1) = Application.Transpose(a)
End With
End Sub
Ich habe den Code insgesamt jetzt nochmal geändert, und arbeite mit einem Array, das dann die Ziel-Tabelle direkt füllt; ist vermutlich effizienter, wenn Du wirklich viele Zellen abklapperst.
Anmerkungen zu Deinen Punkten und dem Code:
1. "Die ganze Tabelle1" sind Millionen von Zellen; das wird die Performance vermutlich in die Knie zwingen. Ich hab's Dir jetzt aber mal soweit ergänzt, dass der "verwendete Bereich" des Blattes abgesucht wird. Schau's Dir in der ergänzten Bsp-Datei mal an...
2. Diesen Punkt kann ich nicht nachvollziehen, tut mir leid (v.a. nicht auf Basis MEINER Bsp-Datei).
3. Ja, Du kannst hier natürlich andere Farbwerte setzen - ich würde das dann aber über die RGB-Codes machen (für Rot bspw. RGB(255,0,0)). Du kannst Dir ja von den verwendeten Schriftfarben die RGB-Codes in der Farbpalette (weitere Farben) ansehen...
4. Spalte 1 des Ziel-Blattes wird am Anfang der Routine gelöscht.
Als letzte Anmerkung: Mein aktueller Code wird bei mehr Elementen als etwas über 65000 (abgearbeitete Zellen), sowie mehr als 255 übertragenen Zeichen je Zelle scheitern; da bräuchte es dann eine andere Herangehensweise. Nur mal so als Heads up.
LG
Michael