Makro Fehler
16.12.2025 12:00:19
Robert Pilz
Sub SummenNachBuchstaben_MehrereBlaetter()
Dim BlattNamen As Variant
BlattNamen = Array( _
"Zentral ABG Nord", "Zentral ABG Mitte", "Zentral ABG SO", _
"Zentral L 1 A", "Zentral L 1 B", "Zentral L 2", _
"Zentral L 3", "Zentral L 4", "Zentral L 5", _
"Zentral L 6 Nord", "Zentral L 6 Süd")
Dim ws As Worksheet
Dim dict As Object
Dim r As Long, i As Long
Dim key As String
Dim menge As Double
Dim c As Long
Dim rowAZ As Long
' ================================
' ALLE ANGEGEBENEN BLÄTTER
' ================================
For i = LBound(BlattNamen) To UBound(BlattNamen)
Set ws = Nothing
On Error Resume Next
Set ws = Worksheets(BlattNamen(i))
On Error GoTo 0
If Not ws Is Nothing Then
Set dict = CreateObject("Scripting.Dictionary")
' ----------------------------
' DATEN SAMMELN
' D = Menge
' FL = Buchstabe
' Muster: r und r+1
' ----------------------------
For r = 5 To 104 Step 3
' Zeile r
key = Trim(ws.Cells(r, "FL").value)
menge = Val(ws.Cells(r, "D").value)
If key > "" Then dict(key) = dict(key) + menge
' Zeile r+1
key = Trim(ws.Cells(r + 1, "FL").value)
menge = Val(ws.Cells(r + 1, "D").value)
If key > "" Then dict(key) = dict(key) + menge
Next r
' ----------------------------
' AUSGABE A–Z FEST
' FQ150 = A … FQ175 = Z
' ----------------------------
ws.Range("FQ150:FR175").ClearContents
For c = 65 To 90 ' ASCII A–Z
rowAZ = 150 + (c - 65)
key = Chr(c)
ws.Cells(rowAZ, "FQ").value = key
If dict.exists(key) Then
ws.Cells(rowAZ, "FR").value = dict(key)
Else
ws.Cells(rowAZ, "FR").value = 0
Next c
End If
Next i
MsgBox "Fertig ? Buchstaben A–Z stehen ab FQ150, Werte je Seite korrekt in FR.", vbInformation
End Sub Fehler beim Kompillieren Next ohne For.
Könnt Ihr helfen.
Danke im voraqus.
LG Robert
Anzeige