Hi,
Kann mir jmd sagen, warum Excel sich bei dem Code immer aufhängt?
Public Sub rid_suchen()
Dim rngAct As Range
Dim strFindFirst As String
Dim intLoopCount As Integer
Dim varFind As Variant
'Begrenzung des zu durchsuchenden Bereichs auf Spalte A
With ActiveSheet.Columns(1)
'1. Übereinstimmung finden
Set varFind = .Find(What:="rid=", After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
If Not varFind Is Nothing Then
'1. Zelle für das Beenden der Do-Loop-Schleife merken
strFindFirst = varFind.Address
Do
'Zelle mit Suchkriterium in Tabelle2 an die gleiche
'Position kopieren.
Range(varFind.Address).Copy _
Destination:=Sheets("Tabelle2").Range(varFind.Address)
For i = 1 To 65536
test = varFind
Cells(i, 3) = test
Dim Text As String
Text = Cells(i, 3)
Ergebnis = Mid(Text, InStr(1, Text, "=") + 1)
Cells(i, 4) = Ergebnis
Next i
'nächste Zelle suchen
Set varFind = .FindNext(varFind)
'Schleife ausführen, solange das Suchkriterium gefunden
'wird und bis letztendlich wieder die 1. Zelle erreicht ist
Loop While Not varFind Is Nothing And varFind.Address <> strFindFirst
End If
End With
End Sub
Viele Grüße
JoBa
Kann mir jmd sagen, warum Excel sich bei dem Code immer aufhängt?
Public Sub rid_suchen()
Dim rngAct As Range
Dim strFindFirst As String
Dim intLoopCount As Integer
Dim varFind As Variant
'Begrenzung des zu durchsuchenden Bereichs auf Spalte A
With ActiveSheet.Columns(1)
'1. Übereinstimmung finden
Set varFind = .Find(What:="rid=", After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
If Not varFind Is Nothing Then
'1. Zelle für das Beenden der Do-Loop-Schleife merken
strFindFirst = varFind.Address
Do
'Zelle mit Suchkriterium in Tabelle2 an die gleiche
'Position kopieren.
Range(varFind.Address).Copy _
Destination:=Sheets("Tabelle2").Range(varFind.Address)
For i = 1 To 65536
test = varFind
Cells(i, 3) = test
Dim Text As String
Text = Cells(i, 3)
Ergebnis = Mid(Text, InStr(1, Text, "=") + 1)
Cells(i, 4) = Ergebnis
Next i
'nächste Zelle suchen
Set varFind = .FindNext(varFind)
'Schleife ausführen, solange das Suchkriterium gefunden
'wird und bis letztendlich wieder die 1. Zelle erreicht ist
Loop While Not varFind Is Nothing And varFind.Address <> strFindFirst
End If
End With
End Sub
Viele Grüße
JoBa