AW: VBA: Zellen formatieren über mehrere Tabellen
05.10.2017 09:57:10
Christian
Hallo Bernd,
diese Variante erledigt den Job deutlich effizienter...
Bei 140 Blätter ist das in der Tat ein Thema!
Sub Schleife3()
With ThisWorkbook.Worksheets("Kürzel")
Dim rng As Range
Set rng = .Cells(1, 1).CurrentRegion
Dim Kuerzel As Variant
' Schleife über Blätter
For Each Kuerzel In rng.Offset(1).Resize(rng.Rows.Count - 1).Rows
With ThisWorkbook.Worksheets(Kuerzel.Cells(1, 2).Value)
' Lezte Zeile
Dim lastRow As Long
lastRow = .Cells(1, 1).End(xlDown).Row
' Bereich in Array übergeben
Dim x As Variant
x = .Range(.Cells(2, 2), .Cells(lastRow, 2))
' String in Date umwandeln
Dim i As Long
For i = LBound(x) To UBound(x)
x(i, 1) = CDate(x(i, 1))
Next i
' Array zurückschreiben
.Range(.Cells(2, 2), .Cells(lastRow, 2)) = x
' Datum formatieren
With .Range(.Cells(2, 2), .Cells(lastRow, 2))
.Interior.Color = rgbLightBlue
.NumberFormat = "DD.MM.YYYY"
End With
' Text in Zahl umwandeln
' Bereich in Array übergeben
x = .Range(.Cells(2, 2), .Cells(lastRow, 8))
For i = LBound(x) To UBound(x)
If IsNumeric(x(i, 1)) Then
x(i, 1) = Replace(x(i, 1), ".", ",") * 1
ElseIf x(i, 1) = "null" Then
x(i, 1) = 0
End If
Next i
' Array zurückschreiben
.Range(.Cells(2, 2), .Cells(lastRow, 8)) = x
' Zahlen formatieren
With .Range(.Cells(2, 3), .Cells(lastRow, 8))
.NumberFormat = "#,######0.000000"
.Interior.Color = rgbLavender
End With
' Zahlen formatieren
With .Range(.Cells(2, 8), .Cells(lastRow, 8))
.NumberFormat = "#,##0.00"
.Interior.Color = rgbLavender
End With
' Nachricht ausgeben
'Debug.Print "Blatt " & .Name & " bearbeitet."
End With
Next Kuerzel
End With
End Sub
VG, Christian