Do Until Schleife

Bild

Betrifft: Do Until Schleife
von: Lukas
Geschrieben am: 26.06.2015 12:48:11

Hallo zusammen,
ich habe folgendes Problem:
Nach dem der Code insgesamt funktioniert, habe ich versucht das ganze als Schleife durchlaufen zu lassen.
Das Problem dabei ist, dass die Schleife nicht mehr verlassen wird, nachdem im Zwischenspeicher Range("B2") leer ist.
Nach Abbruch durch ESC stehen aber alle gewüncshten Werte im Feld.
Was kann ich tun ?
Danke für die Hilfe!
Gruß
Lukas

Sub Eingabe()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        
    Dim Typ As String
    Dim suche As Range
    Dim SapNr As String
    Dim Menge As Integer
    Dim Ende As Long
    Dim Bereich As Range, zelle As Range
    
    
  'Schleife einleiten
  
        Set currentCell = Worksheets("Zwischenspeicher").Range("B2")
  
        Do While Not IsEmpty(currentCell)
                        
       'Werte zuordnen
       
            Sheets("Zwischenspeicher").Activate
      
            Typ = Range("B2").Value     'Typ Variable zuweisen
            Menge = Range("C2").Value   'Menge Variable zuweisen
            SapNr = Range("A2").Value   'SapNr Variable zuweisen
    
'Abfrage auf Vorgabeliste, ob MAE5 freie Kapazität hat
            Sheets("Vorgabeliste").Activate
            
            
            'MAE5
    
            If Range("C3").Value < 3000 Then
       
            'Abfrage ob Typ in der Datenliste abgespeichert ist
         
                Set suche = Sheets("TypenAnlagen").Range("P:P").Find(Typ, LookIn:=xlValues,  _
LookAt:=xlWhole)
    
                If Not suche Is Nothing Then
             
                     
            'In Vorgabeliste eintragen
            
                    Sheets("Vorgabeliste").Activate
            
            'letzte benutzte Zelle in Spalte MAE5 Typ finden
            
                    With ActiveSheet
                    Ende = .Cells(Rows.Count, 2).End(xlUp).Row
                    End With
            
            'Werte eintragen
        
                    Cells(Ende + 1, 1).Value = SapNr
                    Cells(Ende + 1, 2).Value = Typ
                    Cells(Ende + 1, 3).Value = Menge
                
            'Zwischenspeicher leeren für nächsten Wert
                    Sheets("Zwischenspeicher").Activate
                             
                    Rows("2:2").Select
                    Selection.Delete Shift:=xlUp
                
                    Sheets("Vorgabeliste").Activate
                               
                    If Range("C3").Value >= 3000 Then
                    
                        Korrekturwert = Range("C3").Value
                        Übertrag = Korrekturwert - 3000
                                                        
                        'letzte benutzte Zelle im Puffer finden
            
                        With ActiveSheet
                        Ende = .Cells(Rows.Count, 23).End(xlUp).Row
                        End With
            
                        'Werte in Puffer eintragen
        
                        Cells(Ende + 1, 22).Value = SapNr
                        Cells(Ende + 1, 23).Value = Typ
                        Cells(Ende + 1, 24).Value = Übertrag
                        
                        'Wert MAE5 korrigieren
                        
                        With ActiveSheet
                        Ende = .Cells(Rows.Count, 3).End(xlUp).Row
                        End With
                    
                        Korrektur = Cells(Ende, 3).Value - Übertrag
                        Cells(Ende, 3).Value = Korrektur
                    
                    End If
                                              
                End If
                
                
            'Umstieg auf Puffer
            Else
                     
                    'In Vorgabeliste eintragen
            
                        Sheets("Vorgabeliste").Activate
            
                'letzte benutzte Zelle in Spalte 2 finden
            
                        With ActiveSheet
                        Ende = .Cells(Rows.Count, 23).End(xlUp).Row
                        End With
            
                'Werte eintragen
        
                        Cells(Ende + 1, 22).Value = SapNr
                        Cells(Ende + 1, 23).Value = Typ
                        Cells(Ende + 1, 24).Value = Menge
                    
                'Zwischenspeicher leeren für nächsten Wert
            
                        Sheets("Zwischenspeicher").Activate
                             
                        Rows("2:2").Select
                        Selection.Delete Shift:=xlUp
                        
                        Sheets("Vorgabeliste").Activate
                                
            
            End If
                
        
                
        Loop
       
            
       
        
            
        
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

Bild

Betrifft: Schwierig ohne Mappe
von: Jack_d
Geschrieben am: 26.06.2015 13:11:05
Moin Moin,
wenn ich deinen Code richtig verstehe, jagst du deinen Code los und sagst,
Die "CurrentCell" ist B2 und settest diese. Also hast du einen festen wert für Currentcell
Nun sagst du "Mach das und das und jenes solange Currentcell nicht leer ist"
Da aber Currentcell nicht verändert wird läuft die Schleife quasi endlos.
So far ..
Grüße

Bild

Betrifft: AW: Do Until Schleife
von: Werner
Geschrieben am: 26.06.2015 13:57:03
Hallo Lukas,
als erstes ist mir folgendes in deinem Code aufgefallen (hat aber nichts mit deinem Problem zu tun)

Letzte benutzte Zelle in Spalte 2 finden
             
                         With ActiveSheet
                         Ende = .Cells(Rows.Count, 23).End(xlUp).Row
                         End With
Entweder dein Kommentar oder dein Code stimmt nicht. Laut Kommentar willst du die letzte Zeile in Spalte 2 (B) finden, im Code suchst du dann aber die letzte Zeile in Spalte 23 (W).
Ich sehe das auch so wie Jack. Du weist currentCell den Wert aus B2 zu. Da innerhalb deiner Do Loop Schleife currentCell nicht geändert wird hängst du in einer Endlos-Schleife, da currentCell nie leer ist. Oder bei der set Anweisung ist B2 leer, dann läuft die Schleife überhaupt nicht.
Wenn du die set-Anweisung in die Do Loop Schleife setzt, dann bekommt currentCell bei jedem Schleifendurchlauf einen neuen Wert. In deinem Code löschst du sowohl im If als auch im Else Zweig die Zeile 2. Somit wird dann B3 zu B2 (Zeile rutscht beim Löschen ja nach oben). Beim nächsten Durchlauf bekommt currentCell also dann den Wert der vorher in B3 stand. Und das ganze läuft dann so lange, bis in der Spalte B die erste Leerzelle kommt. Ist also die Spalte B durchgehend mit Daten gefüllt, dann löschst du dir alles.
So meine Interpretation.
Gruß Werner

Bild

Betrifft: AW: Antwort
von: Werner
Geschrieben am: 30.06.2015 20:39:19
Hallo,
wohl wieder mal einer der es nicht für nötig hält auf Beiträge zu antworten.
Werner

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Do Until Schleife "