Microsoft Excel

Herbers Excel/VBA-Archiv

If-Then Schleife Vereinfachung

Betrifft: If-Then Schleife Vereinfachung von: na fets
Geschrieben am: 16.09.2014 16:47:00

Hallo zusammen,

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

  

Betrifft: AW: If-Then Schleife Vereinfachung von: Rudi Maintaire
Geschrieben am: 16.09.2014 17:10:51

Hallo,
da die ersten beiden Bedingungen immer gleich sind, würde ich das so machen:

If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 Then
  Select Case .Cells(i, 7).Value
    Case "Freigabe mit Auflage": f = f + 1
    Case "Q-Abweichungsinfo":    Q = Q + 1
    Case "Sonderfreigabe":       s = s + 1
  End Select
End If
Gruß
Rudi


  

Betrifft: AW: If-Then Schleife Vereinfachung von: na fets
Geschrieben am: 17.09.2014 08:10:50

Hallo Rudi,

Danke für deine Antwort, so eine Funktion hat mir gefehlt.
Leider kommt immer noch der Fehler "next ohne for"

Hier der Code:

Sub Auswertung()

'Variablen deklarieren
Dim i As Long, f As Long, q As Long, s 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
    q = 0
    s = 0
    With TB1 'Freigabe mit Auflage
        
  For i = 2 To LR
        
    If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 Then
     Select Case .Cells(i, 7).Value
       Case "Freigabe mit Auflage": f = f + 1
       Case "Q-Abweichungsinfo":    q = q + 1
       Case "Sonderfreigabe":       s = s + 1
     End Select
    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
                q = 0
                s = 0
                m = m + 1
                TB2.Cells(m, 1) = .Cells(i, 3)
    Next i
       
    End With
    
       
    TB2.Activate

End 
Sub ()

Hat jemand eine Idee an was das liegt ? Es ist doch ein  "For" enthalten.

Grüsse und Danke



  

Betrifft: AW: If-Then Schleife Vereinfachung von: na fets
Geschrieben am: 17.09.2014 08:25:51

Hallo Rudi,

Danke für deine Antwort, so eine Funktion hat mir gefehlt.
Leider kommt immer noch der Fehler "next ohne for"

Hier der Code:

Sub Auswertung()

'Variablen deklarieren
Dim i As Long, f As Long, q As Long, s 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
    q = 0
    s = 0
    With TB1 'Freigabe mit Auflage
        
  For i = 2 To LR
        
    If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 Then
     Select Case .Cells(i, 7).Value
       Case "Freigabe mit Auflage": f = f + 1
       Case "Q-Abweichungsinfo":    q = q + 1
       Case "Sonderfreigabe":       s = s + 1
     End Select
    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
                q = 0
                s = 0
                m = m + 1
                TB2.Cells(m, 1) = .Cells(i, 3)
    Next i
       
    End With
    
       
    TB2.Activate

End 
Sub ()

Hat jemand eine Idee an was das liegt ? Es ist doch ein  "For" enthalten.

Grüsse und Danke



  

Betrifft: AW: If-Then Schleife Vereinfachung von: Crazy Tom
Geschrieben am: 17.09.2014 08:46:25

Hallo

das kommt daher, dass du nach der letzten If kein End If hast
MfG Tom


  

Betrifft: AW: If-Then Schleife Vereinfachung von: na fets
Geschrieben am: 17.09.2014 11:44:46

Hallo Tom,

wie peinlich. Das habe ich voll übersehen. Danke, nun funktioniert alles wie gewünscht.

Super Forum!!


 

Beiträge aus den Excel-Beispielen zum Thema "If-Then Schleife Vereinfachung"