If-Then Schleife Vereinfachung
16.09.2014 16:47:00
na
Mittels VBA werte ich eine Datenbank aus. Nun möchte ich mein Makro etwas schneller machen. Dazu will ich 3 if-then Schleifen verschachteln. Somit muss das Programm nur noch einmal die Zeilen durchgehen. Leider kommt eine Fehlermeldung ("next ohne for"). Bin mir aber auch nicht sicher, ob man das so überhaupt vereinfachen kann.
Hier der alte Code:
Sub Auswertung ()
'Variablen deklarieren
Dim i As Long, f As Long, s As Long, Q As Long, LR As Long, LRR As Long, m As Long
Dim TB1, TB2
'Variablen definieren
Set TB1 = Sheets("Tabelle1"): Set TB2 = Sheets("Tabelle2")
LR = TB1.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes
LRR = TB2.Cells.SpecialCells(xlCellTypeLastCell).Row
'Rohdaten in Sachbereiche einteilen und in TB2 eintragen
m = 3
f = 0
With TB1 'Freigabe mit Auflage
For i = 2 To LR
If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 And .Cells(i, _
_
_
_
_
_
7).Value = "Freigabe mit Auflage" Then 'Beanstandungsnummer entspricht Datum
f = f + 1
End If
If .Cells(i, 3).Value "" Then
.Cells(i, 7) = "Bereich" & m
If m > 3 Then TB2.Cells(m, 3) = f
f = 0
m = m + 1
TB2.Cells(m, 1) = .Cells(i, 3)
End if
next i
TB2.Cells(m, 3) = f
end with
'Q-Info
m = 3
Q = 0
With TB1
For i = 2 To LR
If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 And .Cells(i, _
_
_
_
_
_
7).Value = "Q-Abweichungsinfo" Then
Q = Q + 1
End If
If .Cells(i, 3).Value "" Then
.Cells(i, 7) = "Bereich" & m
If m > 3 Then TB2.Cells(m, 7) = Q
Q = 0
m = m + 1
TB2.Cells(m, 1) = .Cells(i, 3)
End If
Next i
TB2.Cells(m, 7) = Q
End With
'Sonderfreigabe
m = 3
s = 0
With TB1
For i = 2 To LR
If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 And .Cells(i, _
_
_
_
_
_
7).Value = "Sonderfreigabe" Then
s = s + 1
End If
If .Cells(i, 3).Value "" Then
.Cells(i, 7) = "Bereich" & m
If m > 3 Then TB2.Cells(m, 5) = s
s = 0
m = m + 1
TB2.Cells(m, 1) = .Cells(i, 3)
End If
Next i
TB2.Cells(m, 5) = s
End With
End Sub
Sub Auswertung neu ()'Variablen deklarieren
Dim i As Long, f As Long, s As Long, Q As Long, LR As Long, LRR As Long, m As Long
Dim TB1, TB2
'Variablen definieren
Set TB1 = Sheets("Tabelle1"): Set TB2 = Sheets("Tabelle2")
LR = TB1.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes
LRR = TB2.Cells.SpecialCells(xlCellTypeLastCell).Row
'Rohdaten in Sachbereiche einteilen und in TB2 eintragen
m = 3
f = 0
s = 0
Q = 0
With TB1 'Freigabe mit Auflage
For i = 2 To LR
If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 And .Cells(i, 7).Value = "Freigabe mit Auflage" Then 'Beanstandungsnummer entspricht Datum
f = f + 1
Else
If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 And .Cells(i, 7).Value = "Q-Abweichungsinfo" Then
Q = Q + 1
Else
If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 And .Cells(i, 7).Value = "Sonderfreigabe" Then
s = s + 1
End If
If .Cells(i, 3).Value "" Then
.Cells(i, 7) = "Bereich" & m
If m > 3 Then TB2.Cells(m, 3) = f
TB2.Cells(m, 5) = s
TB2.Cells(m, 7) = Q
f = 0
s = 0
Q = 0
m = m + 1
TB2.Cells(m, 1) = .Cells(i, 3)
End If
Next i
TB2.Cells(m, 3) = f
TB2.Cells(m, 5) = s
TB2.Cells(m, 7) = Q
End With
End Sub
Ist die Vereinfachung sinnvoll bzw so möglich? Es handelt sich um ca 10000 Zeilen der Datenbank.
Vielen Dank im Voraus.
Gruss