In einer Spalte suchen, auch mit Platzhaltern

Sören · 2005-08-04T10:13:20+02:00

Moin. Ich benötige wieder einmal eure Unterstützung. Mir schwebt folgendes vor: In die Zelle "a1" wird der zu suchende Begriff eingegeben. Die Spalte "D" soll als Beispiel nach diesem Wert durchsucht werden und die Mehrfachtreffer in einem Array abgelegt werden. Ideal wäre es natürlich, wenn in "a1" auch Platzhalter mit verwendet werden können. Bislang habe ich es mit "Find" und mit dem Makrorecorder, ein "suche-Vorgang" aufgezeichnet, probiert.....leider nicht mit einem passenden Ergebnis. "Find" hat bei mir keine Platzhalter akzeptiert und ich habe es nicht geschafft, dass er mit mehrere mögliche Treffer in ein Array legt. Vielleicht habt ihr ja eine gute Idee. Bin für jeden Tipp dankbar. Gruß, Sören

Morgen Sören,
wenn's denn auch 'etwas erweiterte Platzhalter' sein dürfen, versuch mal sowas. Siehe:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/js56jsgrpregexpsyntax.asp
cu, Bernd
--
Option Explicit

Sub SuchenMitRE()
   Dim src As Range, cell As Range
   Dim re As Object
   Dim ar() As String
   Dim arCount As Long

   If Trim(Range("A1").Value) = "" Then
      MsgBox "Suchmuster in Zelle A1 fehlt"
      Exit Sub
   End If
   arCount = -1
   Set re = CreateObject("vbscript.regexp")
   re.Pattern = Range("A1").Value
   On Error Resume Next
   re.test ""
   If Err.Number <> 0 Then
      MsgBox "Fehler in Suchmuster in Zelle A1"
      Exit Sub
   End If
   On Error GoTo 0
   Set src = Range("D1:D" & Cells.SpecialCells(xlCellTypeLastCell).Row)
   For Each cell In src
      If re.test(cell.Value) Then
         arCount = arCount + 1
         ReDim Preserve ar(arCount)
         ar(arCount) = cell.Value
      End If
   Next
   If arCount >= 0 Then Range("E1:E" & arCount + 1) = _
   Application.WorksheetFunction.Transpose(ar)
   Set re = Nothing
End Sub

Guten Morgen,
hatte Gestern nicht gesehen daß Du den Thread noch als offen markiert hast und Dir
das kommentierte Teil an Deine Mail-Addie geschickt...
FWIW, hier einfach nochmal dieses reinkopiert.
cu, Bernd
--
Hallo Sören,
hier ein bischen kommentiert. Da Du ja eigentlich kein Array brauchst, würde es hier auch einfacher gehen.
cu, Bernd
--
Option Explicit
' Anmerkung: Da hier nun in einen Range geschrieben wird könnte man sich
' den gesamten Array-Schickschnack sparen !!


Sub SuchenMitRE()
Dim src As Range     ' Hierin wird gesucht
Dim cell As Range    ' Ein Zelle in src für die Schleife
Dim re As Object     ' ein Regular Expression Objekt
Dim ar() As String   ' ein Array für die gefundenen Werte
Dim arCount As Long  ' Zähler für Elemente im Array, bzw. korrekter:
' Anzahl der Elemente - 1 = Index des aktuellen Elements
' Test ob Suchmuster leer
If Trim(Range("A1").Value) = "" Then
MsgBox "Suchmuster in Zelle A1 fehlt"
Exit Sub
End If
' Array-Index startet ab 0, deshalb Index = -1 um später +1 addieren zu können
arCount = -1
' erstellt ein RE-Objekt
Set re = CreateObject("vbscript.regexp")
' weist dem das Pattern (Suchmuster) zu
re.pattern = Range("A1").Value
' einfacher Test, ob's einen Fehler im Suchmuster gibt
' zum Testen wird einfach ein Leerstring genommen, sollte immer reichen
On Error Resume Next
re.test ""
If Err.Number <> 0 Then
MsgBox "Fehler in Suchmuster in Zelle A1"
Exit Sub
End If
On Error GoTo 0
' src = alle Zellen in Spalte D
Set src = Range("D1:D" & Cells.SpecialCells(xlCellTypeLastCell).Row)
' Schleife über alle Zellen in src
For Each cell In src
' Falls der Zellwert das Suchmuster 'matched', liefert re.Test TRUE
If re.test(cell.Value) Then
' ein Element mehr im Array
arCount = arCount + 1
' dafür Speicher holen aber alte Werte behalten
ReDim Preserve ar(arCount)
' Und noch den Wert eintragen
ar(arCount) = cell.Value
End If
Next
' In arrcount steht der letzte benutzte Index, falls er z.B. 4 ist
' existieren 4 + 1 (!) Elemente mit den Indices 0, 1, 2, 3, 4.
' Range() = ar() 'will eigentlich' ein 2-Dim Feld mit Zeilen&Spalten
' deshalb wird die 1-Dim 'Zeile' in eine 1-Dim Spalte transponiert
' ist sich wohl ein bischen Tricky
If arCount >= 0 Then Range("B4:E" & arCount + 4) = _
Application.WorksheetFunction.Transpose(ar)
' Anständige Leute geben am Ende Objekte wieder frei
Set re = Nothing
End Sub

In einer Spalte suchen, auch mit Platzhaltern

Forumthread: In einer Spalte suchen, auch mit Platzhaltern

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

In einer Spalte suchen mit Platzhaltern in Excel

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

In einer Spalte suchen, auch mit Platzhaltern

Forumthread: In einer Spalte suchen, auch mit Platzhaltern

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

In einer Spalte suchen mit Platzhaltern in Excel

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread