Makro läuft nicht sauber durch
25.11.2004 08:29:56
Manni
derzeit habe ich Probleme mit einer neu entworfenen Datei "Artikel-Suchmaschine". Jedesmal wenn ich den Anstoß zur Artikel-Suche gebe, bekomme ich eine Fehlermeldung. Da mir selber die Makrokenntnisse fehlen, konnte ich den Fehler noch nicht beheben. Bevor ich auch noch mehr Schaden anrichte, möchte ich lieber Gebrauch von dem Wissen eines Makro-Experten in Anspruch nehmen. Ich hoffe, dass mir jemand weiterhelfen kann. Anhang unter:
Die Datei https://www.herber.de/bbs/user/13904.xls wurde aus Datenschutzgründen gelöscht
Option Explicit
Sub zurückzustammdaten()
' Makro am 22.01.2004 von Manfred Fahl aufgezeichnet
Private Sub CommandButton1_Click()
Workbooks("Artikel-Suchmaschine.xls").Close
Windows("Hauptübersicht.xls").Activate
Sheets("Stammdaten").Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim z As Range, lz As Long, i As Long, ze As Long
Dim Such As String, l As Long
Dim test
Dim artikel_nr
Range("B2").Activate
test = ActiveCell
If test = 1 Then
orte = 4 'bei Artikel schrift ab zeile 4
End If
If test = 6 Then
orte = 19 'bei Artikel-Nr schrift zeile 19
GoTo misteln
End If
If Target.Address <> "$A$4" Then Exit Sub
'löscht die zeilen Löschbereich ARTIKEL
Range("C4:K17").Select
Selection.ClearContents
Range("A4").Select
Such = UCase(Target.Value)
l = Len(Such)
If l = 0 Then Exit Sub 'Abbruch bei leerer Zelle
lz = Sheets("Artikel").Range("A65536").End(xlUp).Row
ze = artikel - nr 'artikel-nr = zeile 4 bei 1-und-19 bei 6
For i = 1 To lz 'test
If UCase(Left(Sheets("Artikel").Cells(i, test).Value, l)) = Such Then
Cells(ze, 3) = Sheets("Artikel").Cells(i, 1).Value
Cells(ze, 4) = Sheets("Artikel").Cells(i, 2).Value
Cells(ze, 5) = Sheets("Artikel").Cells(i, 3).Value
Cells(ze, 6) = Sheets("Artikel").Cells(i, 6).Value
Cells(ze, 7) = Sheets("Artikel").Cells(i, 7).Value
Cells(ze, 8) = Sheets("Artikel").Cells(i, 8).Value
Cells(ze, 9) = Sheets("Artikel").Cells(i, 9).Value
Cells(ze, 10) = Sheets("Artikel").Cells(i, 10).Value
ze = ze + 1
End If
Next i
Range("A4").Select
misteln: 'Sprung von goto
'Ab hier wenn B2 = 6 Eingabe Suche nach ARTIKEL-Nr.
If Target.Address <> "$A$4" Then Exit Sub
'löscht die zeilen Löschbereich ARTIKEL-Nr.
Range("C19:K67").Select
Selection.ClearContents
Range("A4").Select
Such = UCase(Target.Value)
l = Len(Such)
If l = 0 Then Exit Sub 'Abbruch bei leerer Zelle
lz = Sheets("Artikel").Range("A65536").End(xlUp).Row
ze = orte '= zeile 4 bei 1-und-19 bei 6
For i = 1 To lz 'test
If UCase(Left(Sheets("Artikel").Cells(i, test).Value, l)) = Such Then
Cells(ze, 3) = Sheets("Artikel").Cells(i, 1).Value
Cells(ze, 4) = Sheets("Artikel").Cells(i, 2).Value
Cells(ze, 5) = Sheets("Artikel").Cells(i, 3).Value
Cells(ze, 6) = Sheets("Artikel").Cells(i, 6).Value
Cells(ze, 7) = Sheets("Artikel").Cells(i, 7).Value
Cells(ze, 8) = Sheets("Artikel").Cells(i, 8).Value
Cells(ze, 9) = Sheets("Artikel").Cells(i, 9).Value
Cells(ze, 10) = Sheets("Artikel").Cells(i, 10).Value
'Hier erweitern falls erforderlich
ze = ze + 1
End If
Next i
Range("A4").Select
End Sub
Gruß
Manni