Hallo an alle VBA-Spezies,
ich habe ein Problem mit Laufzeitfehler 91 "Objektvariable oder With-Blockvariable nicht festgelegt". Erklärung weiter unten im Code..
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Weiter, lngZeile As Long, rngZelle As Range, bolUeberschreiben As Boolean, lngZeile1 As Long
Dim bolUeberschreiben1 As Boolean, rngZelle1 As Range, lngZeile2 As Long, rngZelle2 As Range, lngZeile3 As Long, rngZelle3
Dim rngZelle4 As Range, lngZeile4 As Long
Dim wksSchrott As Worksheet, wksSP As Worksheet, wkbSP As Workbook
... (anderer Code)
If Target.Column = 11 Then
If Cells(Target.Row, 11).Value = "" Then
Exit Sub
Else:
If Cells(Target.Row, 4).Value <> "" And Cells(Target.Row, 8).Value <> "" Then
Set wksSchrott = Worksheets("Material verschrotten")
'Nächste leere Zeile in "Material verschrotten"
With wksSchrott
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
bolUeberschreiben = False
'Prüfen, Eintrag bereits vorhanden
If Application.CountIf(wksSchrott.Range("A:A"), Cells(Target.Row, 1).Value) > 0 Then
Set wksSchrott = Worksheets("Material verschrotten")
With wksSchrott
Set rngZelle2 = .Columns(1).Find(what:=Cells(Target.Row, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
->->-> hier entsteht das Problem, weil rngZelle2 keinen Zellinhalt bekommt - Wert = "Nothing"
lngZeile2 = rngZelle2.Row
->->-> und dann kommt Laufzeitfehler 91, weil er zum Zelleninhalt "Nothing" natürlich auch keine passende Zeile finden kann.
End With
Weiter = MsgBox("Achtung, Eintrag bereits vorhanden. " & vbLf _
& " Möchten Sie den vorhandenen Eintrag überschreiben?" & vbLf _
& "Eintrag lautet: " & wksSchrott.Cells(lngZeile2, 2).Value & vbLf _
& "Menge: " & wksSchrott.Cells(lngZeile2, 3).Value & vbLf _
& "Wert: " & wksSchrott.Cells(lngZeile2, 4).Value & "EUR", vbYesNo)
If Weiter = vbYes Then
bolUeberschreiben = True
End If
If bolUeberschreiben = True Then
With wksSchrott
Set rngZelle = .Columns(1).Find(what:=Cells(Target.Row, 1).Value, LookIn:=xlValues, _
lookat:=xlWhole)
lngZeile = rngZelle.Row
End With
wksSchrott.Cells(lngZeile, 2).Value = Cells(Target.Row, 11).Value
wksSchrott.Cells(lngZeile, 3).Value = Cells(Target.Row, 20).Value
wksSchrott.Cells(lngZeile, 4).Value = Cells(Target.Row, 42).Value
wksSchrott.Cells(lngZeile, 8).Value = Cells(Target.Row, 20).Value
wksSchrott.Cells(lngZeile, 9).Value = Cells(Target.Row, 21).Value
wksSchrott.Cells(lngZeile, 10).Value = Cells(Target.Row, 22).Value
wksSchrott.Cells(lngZeile, 11).Value = Cells(Target.Row, 23).Value
wksSchrott.Cells(lngZeile, 12).Value = Cells(Target.Row, 24).Value
wksSchrott.Cells(lngZeile, 13).Value = Cells(Target.Row, 4).Value
wksSchrott.Cells(lngZeile, 14).Value = Cells(Target.Row, 8).Value
wksSchrott.Cells(lngZeile, 15).Value = Cells(Target.Row, 7).Value
Else:
MsgBox ("Wert wird zurückgesetzt")
Cells(Target.Row, 11).Value = ""
End If
Else:
wksSchrott.Cells(lngZeile, 1).Value = Cells(Target.Row, 1).Value
wksSchrott.Cells(lngZeile, 2).Value = Cells(Target.Row, 11).Value
wksSchrott.Cells(lngZeile, 3).Value = Cells(Target.Row, 20).Value
wksSchrott.Cells(lngZeile, 4).Value = Cells(Target.Row, 42).Value
wksSchrott.Cells(lngZeile, 8).Value = Cells(Target.Row, 20).Value
wksSchrott.Cells(lngZeile, 9).Value = Cells(Target.Row, 21).Value
wksSchrott.Cells(lngZeile, 10).Value = Cells(Target.Row, 22).Value
wksSchrott.Cells(lngZeile, 11).Value = Cells(Target.Row, 23).Value
wksSchrott.Cells(lngZeile, 12).Value = Cells(Target.Row, 24).Value
wksSchrott.Cells(lngZeile, 13).Value = Cells(Target.Row, 4).Value
wksSchrott.Cells(lngZeile, 14).Value = Cells(Target.Row, 8).Value
wksSchrott.Cells(lngZeile, 15).Value = Cells(Target.Row, 7).Value
End If
Else:
MsgBox ("Bitte füllen Sie die Spalten D und H aus.")
Cells(Target.Row, 11).Value = ""
Cells(Target.Row, 11).Select
End If
End If
End If
.... (anderer Code)
Wäre für den "entscheidenden Tipp" sehr dankbar.
LG,
Melanie