on error will nur einmal
10.10.2003 07:05:07
Marco G.
ich hab mein Problem langsam in den Griff bekommen jetzt hab ich nur noch das Problem wenn der Wert nicht gefunden wird den ich mit cells.find ermittel, dann soll der on error Befehl das abfangen. einmal macht er das auch, nur beim zweiten mal funktioniert das nicht mehr.
wodran kann das liegen?
langsam gehen mir da echt die Ideen aus.
Bitte um Hilfe.
mfG Marco
Sub suchen()
On Error GoTo info
zielzelle = "C2"
suchausdruck = "*r*dyn*"
durchlauf = 0
GoTo schleife
info:
MsgBox suchausdruck & " nicht gefunden!"
If Err.Number = 91 Then GoTo durchlauf
Exit Sub
1:
suchausdruck = "*1*Gang*"
zielzelle = "C3"
GoTo schleife:
2:
suchausdruck = "*2*Gang*"
zielzelle = "C4"
GoTo schleife:
3:
suchausdruck = "*3*Gang*"
zielzelle = "C5"
GoTo schleife:
4:
suchausdruck = "*4*Gang*"
zielzelle = "C6"
GoTo schleife:
5:
suchausdruck = "*5*Gang*"
zielzelle = "C7"
GoTo schleife:
6:
suchausdruck = "*6*Gang*"
zielzelle = "C8"
GoTo schleife:
7:
suchausdruck = "*cw*ert*"
zielzelle = "C15"
GoTo schleife:
8:
suchausdruck = "*irnfl*che*"
zielzelle = "C17"
GoTo schleife:
9:
suchausdruck = "*chs*bersetzu*"
zielzelle = "C12"
GoTo schleife:
10:
suchausdruck = "*irkungsgrad*"
zielzelle = "C10"
GoTo schleife:
11:
suchausdruck = "*irkungsgrad*achs*"
zielzelle = "C11"
GoTo schleife:
12:
suchausdruck = "*asse*"
zielzelle = "C14"
GoTo schleife:
13:
suchausdruck = "*ollwiderstand*"
zielzelle = "C16"
GoTo schleife:
schleife:
durchlauf = durchlauf + 1
Set c = Cells.Find(What:=suchausdruck, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False)
mysti = (c.Address(RowAbsolute, ColumnAbsolute))
LeereZelleSpalte = Range(c.Offset(), c.Offset()).End(xlToRight).Address(RowAbsolute, ColumnAbsolute)
myst = Range(LeereZelleSpalte).Value
If (IsNumeric(myst)) And Range(LeereZelleSpalte).Value <> 0 Then
Range(LeereZelleSpalte).Copy
'wkbAlt.
Sheets(2).Range(zielzelle).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
If (IsNumeric(Cells(c.Row, c.Column + 1))) And Cells(c.Row, c.Column + 1) <> "" Then
Cells(c.Row, c.Column + 1).Copy
'wkbAlt.
Sheets(2).Range(zielzelle).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
GoTo durchlauf
durchlauf:
If durchlauf = 1 Then GoTo 1
If durchlauf = 2 Then GoTo 2
If durchlauf = 3 Then GoTo 3
If durchlauf = 4 Then GoTo 4
If durchlauf = 5 Then GoTo 5
If durchlauf = 6 Then GoTo 6
If durchlauf = 7 Then GoTo 7
If durchlauf = 8 Then GoTo 8
If durchlauf = 9 Then GoTo 9
If durchlauf = 10 Then GoTo 10
If durchlauf = 11 Then GoTo 11
If durchlauf = 12 Then GoTo 12
If durchlauf = 13 Then GoTo 13
If durchlauf = 14 Then
Exit Sub
End If
End Sub