Problem mit findNext

Hallo zusammen.

Ich hab mir folgenden Code überlegt:

Sheets(sheet).Select
Range("g:g,dc:dc").Select

j = 0
With Selection

Set found2 = .Find(what:=Val(artNo), lookat:=xlWhole)
If found2 Is Nothing Then
GoTo nextsheet
End If

foundfirst = found2.Address

Do Until (found2 Is Nothing)
notfound = 0
j = j + 1
preisalt = found2.Offset(0, 5)
found2.Offset(0, 5) = preis
r = found.Row
c = found.Column

Call getTotalAlt(r, c, artnr, reznr, totalNeu)
Call writeTotalNeu(artnr, reznr, artNo, totalNeu)

i = 1
Do Until (IsEmpty(found2.Offset(0, i)))
i = i + 1
If (i >= 49) Then
'found2.Activate
MsgBox ("Kein Platz für weitere Preisänderung")
End
End If
Loop

found2.Offset(0, i) = Date
found2.Offset(o, i + 1) = preisalt
-->>> x Set found2 = .FindNext(found2)
If (found2.Address = foundfirst) Then
Exit Do
End If

Loop
End With

dazu die Funktionen :


Private Function getTotalAlt(y, x, artnr, reznr, totalNeu)
If x < 100 Then
Cells(y, 1).Select
artnr = Cells(y, 1)
reznr = Cells(y, 3)
Do Until (IsEmpty(ActiveCell))
Selection.Offset(1, 0).Select
Loop
totalNeu = Selection.Offset(-1, 12)
ElseIf x > 100 Then
Cells(r, 101).Select
Do Until (IsEmpty(ActiveCell))
Selection.Offset(1, 0).Select
Loop
totalNeu = Selection.Offset(-1, 12)
End If
End Function

und


Private Function writeTotalNeu(artnr, reznr, artNo, totalNeu)
Sheets("Produktionspreise").Select
Range("c:c").Select
On Error GoTo SuchenachReznr
Selection.Find(what:=artnr, lookat:=xlWhole).Select
totalAlt = Selection.Offset(0, 2)
Selection.Offset(0, 2) = totalNeu
weiter:
Do Until (IsEmpty(ActiveCell))
Selection.Offset(0, 1).Select
Loop
ActiveCell = totalAlt
ActiveCell.Offset(0, 1) = "geänderter Rohstoff " + artNo
ActiveCell.Offset(0, 2) = "Änderungsdatum " + Str(Date)
GoTo ende1
SuchenachReznr:
Selection.Find(what:=reznr, lookat:=xlWhole).Activate
totalAlt = Selection.Offset(0, 1)
Selection.Offset(0, 1) = totalNeu
GoTo weiter
ende1:
End Function

Wenn ich die Funtkionen nicht aufrufe läuft alles wie geschmiert.

Nach den beiden Funktionen wird in der Zeile x found mit "Nothing" belegt,obwohl noch jede Menge zu finden ist.

Ich vermute das es auf ein Problem mit "With Selection" zurückzuführen ist,weiss aber nicht genau wie ich das umgehen kann.

Vielen Dank im Vorraus.

Gruss Alex.

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Sub suchen() Dim Zelle As Range, Suchbegriff As String, Adresse As String, zaehler As Integer Dim index As Integer, Feld() As String, Tabelle() As Integer, Zeile_Spalte() As String Suchbegriff = InputBox("Suchbegriff eingeben", "Eingabe") If Suchbegriff <> "" Then For index = 1 To Worksheets.Count With Sheets(index).Cells Set Zelle = .Find(What:=Trim(Suchbegriff), LookAt:=xlPart) If Not Zelle Is Nothing Then Adresse = Zelle.Address Do zaehler = zaehler + 1 ReDim Preserve Feld(1 To zaehler) ReDim Preserve Tabelle(1 To zaehler) ReDim Preserve Zeile_Spalte(1 To zaehler) Feld(zaehler) = Sheets(index).Name & " Spalte " & Zelle.Column & " Zeile " & Zelle.Row Tabelle(zaehler) = index Zeile_Spalte(zaehler) = Zelle.Address Set Zelle = .FindNext(Zelle) Loop While Not Zelle Is Nothing And Zelle.Address <> Adresse End If End With Next If zaehler > 0 Then If MsgBox(Suchbegriff & " wurde " & CStr(zaehler) & " mal gefunden." & vbNewLine & "Fundstellen anzeigen?", 68, "Information") = 7 Then Exit Sub Do For index = 1 To zaehler Sheets(Tabelle(index)).Select Range(Zeile_Spalte(index)).Select ActiveWindow.ScrollColumn = Selection.Column ActiveWindow.ScrollRow = Selection.Row If zaehler = 1 Then Exit Sub If index < zaehler Then If MsgBox(CStr(index) & ". Fundstelle von " & CStr(zaehler) & ": " & Feld(index) & vbNewLine & "Weitere anzeigen?", 68, "Information") = 7 Then Exit Sub Else If MsgBox(CStr(index) & ". Fundstelle von " & CStr(zaehler) & ": " & Feld(index) & vbNewLine & "Nochmal anzeigen?", 68, "Information") = 7 Then Exit Do End If Next Loop Else MsgBox Suchbegriff & " wurde nicht gefunden", 64, "Information" End If End If End Sub

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread