AW: Suche auf Maskierte Artikelnummer?
10.08.2007 19:01:25
fcs
Hallo yosherl,
bei der Datenmenge wird es schwierig.
Wenn die Daten in der 2. Datei aufsteigend sortiert sind (Zuerst die mit ? am Anfang, dann die restlichen), dann bringt folgende Anpasssung eine Beschleunigung.
Die Zellen mit ? als 1. Zeichen werden komplett duchsucht.
Dann wird nach der Zelle gesucht in der der 1. Anfangsbuchstabe übereinstimmt. Keine Ahnung wie gross der Zeitgewinn wird. Das hängt jetzt von den Datenmengen der einzelnen Buchstabengruppen ab.
Ob weitere Beschleunigungen möglich sind, kann man nur abschätzen, wenn man die Daten besser kennt.
Evtl. ist es tatsächlich auch sinnvoll, die zu vergleichenden Daten jweils in ein Array einzulesen. Immerhin brachte alleine das Einlesen des zu vergleichenden Strings in eine Variable schon fast 50% Zeitgewinn.
Gruß
Franz
Sub MaskenSuche()
Dim Zelle1 As Range, strSuch As String, wb1 As Workbook, wks1 As Worksheet, i As Long
Dim Zelle2 As Range, wb2 As Workbook, wks2 As Worksheet, boGefunden As Boolean
Dim strFinden As String, start2 As Range
Set wb1 = Workbooks("YoshDatei1.xls")
Set wks1 = wb1.Worksheets("Tab1")
Set Zelle1 = ActiveCell
strSuch = Zelle1.Value 'Suchbegriff
'Datei und Tabelle in der gesucht werden soll
Set wb2 = Workbooks("YoshDatei2.xls")
Set wks2 = wb2.Worksheets("Tab1")
'Spalte 1 in YoshDatei2.xls!Tab1 auf passenden Eintrag durchsuchen
'Zellen mit ? als 1. Zeichen durchsuchen
For Each Zelle2 In wks2.Range(wks2.Cells(1, 1), wks2.Cells(wks2.Rows.Count, 1).End(xlUp))
strFinden = Zelle2.Value
boGefunden = False
If Left(strFinden, 1) "?" Then
Exit For
Else
If Len(strFinden) = Len(strSuch) Then
boGefunden = True
For i = 1 To Len(strSuch)
If Not (Mid(strFinden, i, 1) = Mid(strSuch, i, 1) _
Or Mid(strFinden, i, 1) = "?") Then
boGefunden = False
Exit For
End If
Next
Else
boGefunden = False
End If
End If
If boGefunden = True Then
MsgBox "Suchbegriff: " & strSuch & " passt zu: " & strFinden & "in Zelle: " & Zelle2. _
Address
Exit For
End If
Next
'Restliche Zellen durchsuchen
If boGefunden = False Then
'Zelle suchen ab der 1. Zeichen übereinstimmt
If Left(strFinden, 1) = Left(strSuch, 1) Then
Set start2 = Zelle2
Else
Set start2 = wks2.Range(Zelle2, wks2.Cells()).Find(What:=Left(strSuch, 1) & "*", _
After:=Zelle2, LookIn:=xlFormulas, LookAt:=xlWhole)
End If
If start2 Is Nothing Then
boGefunden = False
Else
For Each Zelle2 In wks2.Range(start2, wks2.Cells(wks2.Rows.Count, 1).End(xlUp))
strFinden = Zelle2.Value
boGefunden = False
If Left(strFinden, 1) Left(strSuch, 1) Then Exit For
If Len(strFinden) = Len(strSuch) Then
boGefunden = True
For i = 1 To Len(strSuch)
If Not (Mid(strFinden, i, 1) = Mid(strSuch, i, 1) _
Or Mid(strFinden, i, 1) = "?") Then
boGefunden = False
Exit For
End If
Next
Else
boGefunden = False
End If
If boGefunden = True Then
MsgBox "Suchbegriff: " & strSuch & " passt zu: " & strFinden & "in Zelle: " & Zelle2. _
Address
Exit For
End If
Next
End If
End If
If boGefunden = False Then
MsgBox "Für Suchbegriff: " & strSuch & " wurde kein passender Eintrag gefunden"
End If
End Sub