AW: Suchfunktion Berücksichtigung von bis Zahlen
16.01.2015 18:27:30
bis
Hallo Fred,
wie Deine 9 Tabelleblätter heißen, musst Du selbst in den Array vBlatt eintragen, die anderen Wünsche sollte ich erfüllt haben.
Gruß Peter
Option Explicit
' ich bräuchte eine Suchfunktion.
' In den ersten 9 Tabellenblättern habe ich in Spalte "O" Aktennummern stehen.
' Das sieht etwa so aus:
' Alt. 258
' Alt. 189 - 191
' Neu. 879 - 882
' Altb. 789
' Alta. 963
' Neu. 698
' Alt. 145
' Neu. 478 + 479
' usw.
' Nun sollte die Suche so sein dass ich als Suchbegriff nur die Aktennummer eingebe,
' also z.B. 190. Die voranstehenden Buchstaben sollen nicht berücksichtigt werden.
' Die Suche sollte dann in der Zelle enden wo halt die 190 steht.
' Das Problem ist sicherlich die Akten zu finden wo z.B. von bis angegeben ist (189 - 191)
' Hilfreich wäre auch nach erfolgter Suche die Möglichkeit per Schaltfläche weiter zu suchen,
' oder abzubrechen wobei dann die letzte gefundene Zelle sichtbar bleibt.
Public Sub Suchen()
Dim sSuchbegriff As String ' der Suchbegriff
Dim vBlatt As Variant ' die 9 auszuwertenden Tabellenblätter als Array
Dim iBlatt As Integer ' der For/Next Schleifen-Index zum Array
Dim lZeile As Long ' der For/Next Schleifen-Index für die Spalte O
Dim iPosition As Integer ' die Position diverser Schlüsselbegriffe
Dim sWert As String ' der Von-Bis Suchbegriff
Dim Von As Long ' der Von Suchbegriff
Dim Bis As Long ' der Bis Suchbegriff
vBlatt = Array("Tabelle1", "Tabelle2", "Tabelle3") ' usw. - die ersten 9 Tabellenblätter
sSuchbegriff = ThisWorkbook.Worksheets("Menü").Range("K30").Value
For iBlatt = 0 To UBound(vBlatt)
With ThisWorkbook.Worksheets(vBlatt(iBlatt))
' die Spalte O abarbeiten
For lZeile = 2 To .Cells(.Rows.Count, 15).End(xlUp).Row
' die Position des Zellinhaltes ". " suchen
iPosition = InStr(.Range("O" & lZeile).Value, ". ")
' alles was nach dme ". " kommt speichern
sWert = Mid(.Range("O" & lZeile).Value, iPosition + 2)
' evtl. vorhandene Leerzeichen eliminieren
sWert = Replace(sWert, " ", "")
' evtl. vorhandene + Zeichen in - Zeichen umwandeln
sWert = Replace(sWert, "+", "-")
' gibt es kein - Zeichen?
If InStr(sWert, "-") > 0 Then
Else
' dann wird eines eingefügt und der alleinstehende Wert dahinter eingefügt
sWert = sWert & "-" & sWert
End If
' nun wird der erste numerische Wert als Von-Bereich übernommen
Von = Val(sWert)
' es wird die Position des - Zeichens gesucht
iPosition = InStr(sWert, "-")
' nun wird der zweite numerische Wert als Bis-Bereich übernommen
Bis = Val(Mid(sWert, iPosition + 1))
' mit den Von to Bis Werten wird ein Select Case ausgewertet
Select Case sSuchbegriff ' der gesuchte Begriff !!!
Case Von To Bis
'MsgBox "gefunden in Zelle ""O" & lZeile & """", _
64, " Information für " & Application.UserName
.Range("A" & lZeile & ":Z" & lZeile).Select
End Select
Next lZeile
End With
Next iBlatt
End Sub