VBA Excel Fehler 91 Objektvariable oder With-Blockvariable nicht festgelegt

Question

Bei folgendem Code (Ausschnitt) zeigt es immer einen Fehler an, hab bereits gegoogelt habe aber keine Lösung gefunden:

      
        Set ergebnis = Worksheets("Tabelle1").Columns(9).Find(c, LookIn:=xlValues, lookat:=xlWhole)
           
            'bei Übereinstimmung und freie Stelle
            If (Not ergebnis Is Nothing And IsEmpty(Cells(ergebnis.Row, 10))) Then
                    Worksheets("Tabelle1").Cells(ergebnis.Row, 10).Value = p
                    Worksheets("Tabelle1").Cells(ergebnis.Row, 11).Value = r
     
            Else    'Weitersuchen
            Do
                Set ergebnis = Worksheets("Tabelle1").Columns(9).FindNext(after:=ergebnis)
                   
                'bei Übereinstimmung und freie Stelle
                If (Not ergebnis Is Nothing And IsEmpty(Cells(ergebnis.Row, 10))) Then  'hier kommt der Fehler
                    Worksheets("Tabelle1").Cells(ergebnis.Row, 10).Value = p
                    Worksheets("Tabelle1").Cells(ergebnis.Row, 11).Value = r
                    Exit Do
                                   
                End If
            'Weitersuchen bis komplette Spalte gefüllt ist
            Loop While Not IsEmpty(Range("J2", "J" & finalRow))
                                              
            End If
                  
 

 

Answer 1

Hallo Clone,

der von dir gepostete Code läuft ohne Fehler durch. Poste doch mal den gesamten Code.

Gruß

M.O.

Answer 2

Hallo M.O., hier der komplette Code von mir:

---

Sub Logik()

    'Aktives Blatt auswählen (Abänderung für jeweiligen Gang)
    Sheets("Tabelle3").Select
   
    'Letzte Zeile finden (Anzahl)
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
   
    'Variablen-Deklaration:
    Dim p As String                   
    Dim c As String                     
       
    Dim r As Integer              
    r = 1
   
    Dim y As Integer                  
    Dim x  As Integer
    x = 2
            
    Dim d As String
    d = "draußen"
    Cells(x, 10).Value = d
    Cells(x, 11).Value = r
               
'Schleife Anfang - Schleife in Schleife
       
    'Startwert =  y (wird am Schleifenende neu übergeben)
    For y = 2 To finalRow Step 1
             
        'Reihenfolge um eins erhöhen (Counter)
        r = r + 1

        p = Cells(y, 4).Value
        c = Cells(y, 8).Value
             
         Dim ergebnis As Range
       
        Set ergebnis = Worksheets("Tabelle3").Columns(9).Find(c, LookIn:=xlValues, lookat:=xlWhole)
           
            'bei Übereinstimmung und freie Stelle - Werte einschreiben
            If (Not ergebnis Is Nothing And IsEmpty(Cells(ergebnis.Row, 10))) Then
                    Worksheets("Tabelle3").Cells(ergebnis.Row, 10).Value = p
                    Worksheets("Tabelle3").Cells(ergebnis.Row, 11).Value = r
                          
            Else    'ansonsten Weitersuchen
           
            Do
                Set ergebnis = Worksheets("Tabelle3").Columns(9).FindNext(ergebnis)
                   
                'bei Übereinstimmung und freie Stelle
                If (Not ergebnis Is Nothing And IsEmpty(Cells(ergebnis.Row, 10))) Then
                    Worksheets("Tabelle3").Cells(ergebnis.Row, 10).Value = p
                    Worksheets("Tabelle3").Cells(ergebnis.Row, 11).Value = r
                    'wenn erfolgreich dann Schleife verlassen
                    Exit Do
                End If
                    'Weitersuchen bis komplette Spalte gefüllt ist
                    Loop While Not IsEmpty(Range("J2", "J" & finalRow))
                                              
            End If
                         
            'jetzige Zeile als neuen "Startwert" für Schleife
            y = Worksheets("Tabelle3").Cells(ergebnis.Row - 1, 1).Value
                               
    Next y
'Schleife Ende
       
End Sub

Answer 3

Hallo Clone,

kann es sein, dass du das Makro abgebrochen hat, weil der Code in einer Entlosschleife (jedenfalls bei meiner Testdatei) läuft und danach dann der Fehler aufkam?

Gruß

M.O.

Answer 4

Hallo M.O.

ja genau, ich weiß auch nicht wie ich das so umstellen kann, dass keine Endlosschleife daraus entsteht. Ich dachte ich hätte eigentlich eine Art Abbruchbedingung eingebaut.

Trotz allem versteh ich nicht was das mit dem Fehler zu tun hat :( 

Answer 5

Hi,

kannst du eine Beispielmappe bereitstellen?

Bis später, Karin

Answer 6

Hallo Clone,

das scheint ein Bug zu sein (so jedenfalls hier).

Deine Abbruchbedingung funktioniert ja nur, wenn in der ganzen Spalte I dein Suchbegriff stehen würde, mit dem du die Suche starten würdest (was aber wahrscheinlich nicht der Fall ist).

Erkläre doch mal, was du mit Makro erreichen willst und stelle wie von Karin vorgeschlagen ggf. eine Beispielmappe mit ein paar Dummydaten zur Verfügung. Wie das funktioniert kanns du hier nachlesen: Anleitung

Gruß

M.O.

Answer 7

Hallo ihr beiden,

ich möchte mit meinem Code eine Umdisponierungslogik darstellen: man hat Artikel die alle auf einem bestimmten Platz liegen (PLATZ ALT), jetzt sollen die Artikel umgelagert werden und entsprechend der Cluster ein neuen Platz gewiesen bekommen. Es muss beachten werden, dass der neue Platz zuvor frei ist.

Hier eine Beispiel-Datei mit gewünschtem Ergebnis.

Die Schleife soll enden, wenn alle Plätze neu vergeben worden sind.

Gruß Clone

Answer 8

Hallo Clone,

ich habe mal einen Code nach meinem Verständnis gebastelt. Bei mir kommt eine leicht andere Reihenfolge heraus, als du in deiner Beispieldatei vorgegeben hast, aber schau einfach mal:

Sub umsortieren()

Dim lngLetzte As Long
Dim arrLager As Variant
Dim lngZaehler As Long
Dim a As Long
Dim b As Long

'letzte beschrieben Zeile ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Daten in Array einlesen
'hier die Spalten A bis G ab Zeile 2
arrLager = Range(Cells(2, 1), Cells(lngLetzte, 7))

'1. Datensatz wird rausgenommen
'Zähler für Reihenfolge erhöhen
lngZaehler = lngZaehler + 1
'wird herausgenommen und enthält nach Abschluss der Umsortierung den letzten Platz
arrLager(1, 6) = arrLager(UBound(arrLager, 1), 3)
'Reihenfolge
arrLager(1, 7) = lngZaehler

'nun alles umordnen
For a = LBound(arrLager, 1) To UBound(arrLager, 1)
  For b = LBound(arrLager, 1) To UBound(arrLager, 1)
     'alten und neuen Cluster vergleichen
     If arrLager(a, 4) = arrLager(b, 5) Then
       'leeren Platz gefunden?
       If arrLager(b, 6) = "" Then
         'Zähler für Reihenfolge erhöhen
         lngZaehler = lngZaehler + 1
         'Platz dem neuen Cluster zuordnen
         arrLager(b, 6) = arrLager(a, 3)
         'Reihenfolge
         arrLager(b, 7) = lngZaehler
         'b-Schleife verlassen
         Exit For
      End If
    End If
  Next b
 Next a

'Daten zurückschreiben
Range(Cells(2, 1), Cells(lngLetzte, 7)) = arrLager

End Sub

Gruß

M.O.

Answer 9

Hallo M.O., erstmal danke für deine Mühe und den bereitgestellten Code,  ich schau mir den Code gleich mal an und probiere ihn aus!

Wie müsste ich meinen Code ändern, damit ich eine "korrekte" Abbruchbedingung für die Schleife hin bekomme? - ich bin VBA-Anfänger und das ganze mit VBA noch nicht richtig verstanden :(

Gruß Clone

Answer 10

Hallo Clone,

teste einfach mal deine Abbruchbedingung in einem leeren Arbeitsblatt und fülle dann mal die Zellen J2 bis J10 und teste deine Abbruchbedingung erneut:

Sub test()
Dim finalrow As Long
finalrow = 10
If Not IsEmpty(Range("J2", "J" & finalrow)) Then MsgBox "alles gefüllt"
End Sub

Du wirst sehen, dass es hier keinen Unterschied macht, ob die Zellen leer oder gefüllt sind. Wenn du überprüfen willst, ob alle Zellen in einem Bereich gefüllt sind, dann schau mal hier nach: Link.

Gruß

M.O.