Excel 2010 - Makro für Suchen und Zelle notieren wo gefunden

Pulvertoastmann

Lt. Junior Grade
Registriert
Mai 2008
Beiträge
497
Hallo Liebe Excel & VBA-Kenner ;),

ich hoffe Ihr könnt mir bei folgendem Anliegen helfen:

Habe derzeit zwei Tabellenblätter offen; im ersten Blatt steht in der Spalte A
ein Wort drin.

Ich würde gerne per Makro, weil mir an der Stelle leider die Vergleichsformel nichts bringt,
dieses Wort im zweiten Tabellenblatt in der Spalte A suchen. Es ist jedoch so, dass
im zweiten Blatt in der ersten Spalte mehrere Wörter in einer Zelle stehen.

Wenn dieses Wort gefunden wird, dann sollte wenn möglich in Spalte B eingetragen
werden in welchen Zellen dieses Wort gefunden wurde.

tabellenblatt 1 Spalte A.PNG tabellenblatt 2 Spalte A.PNG

Ist das überhaupt möglich? Über ein paar Vorschläge würde ich mich sehr freuen.

Beste Grüße
 
Das einfachste wäre wohl mit der InStr-Funktion zu prüfen, ob der String aus der ersten Spalte im String in der zweiten Spalte vorkommt. Das kann natürlich zu Fehlern führen ('und' wäre auch in 'Hund' enthalten).

Besteht die Möglichkeit, die zweite Spalte über Daten | Text in Spalten zu trennen, damit eben nicht mehr mehrere Wörter in einer Zelle stehen?
 
Hi,

danke für die Vorschläge. Nehme grad Riddlers Link unter die Lupe.

@snoot
leider besteht die Möglichkeit nicht in der zweiten Spalte :/

@riddler
ich verstehe das so, dass Countif einfach nur aufzählt wie oft es vorhanden ist,
und mir nicht anzeigt in welcher Zelle es vorkommt
 
Zuletzt bearbeitet:
Probier mal das:
Code:
Dim sFinde As String, sVgl As String
Dim wksFinde As Worksheet, wksVgl As Worksheet

Sub woerter_finden()

Set wksFinde = Sheets("Tabelle1")
Set wksVgl = Sheets("Tabelle2")

'Suchbegriffe der Reihe nach durchlaufen'
For i = 1 To wksFinde.Range("A10000").End(xlUp).Row

  'Suchbegriff in Variable speichern'
  sFinde = wksFinde.Range("A" & i).Value
  
  'Vergleichsliste der Reihe nach durchlaufen'
  For k = 1 To wksVgl.Range("A10000").End(xlUp).Row
    
    'Vergleichswert in Variable speichern'
    sVgl = wksVgl.Range("A" & k).Value
    
    'Prüfen, ob der Suchbegriff am Anfang, Ende oder in der Mitte des Vergleichswertes vorkommt'
    If Left(sVgl, Len(sFinde) + 1) = sFinde & " " Or _
       Right(sVgl, Len(sFinde) + 1) = " " & sFinde Or _
       InStr(1, sVgl, " " & sFinde & " ", 1) Then
      
      'Zeilennummer k aus Vergleichsliste in Suchliste eintragen'
      wksFinde.Range("B" & i).Value = k
    End If

  Next k

Next i
End Sub
 
Zuletzt bearbeitet:
hey snoot, kam erst heute früh zum testen. DANKE, klappt schonmal wunderbar.
Ist es eigtl möglich, dass wenn das Wort mehrmals gefunden wurde
auch die betreffenden Zellen in B geschrieben werden?

p.s. Kann man das Makro so einstellen das Groß-/Kleinschreibung nicht
mit berücksichtigt wird?
 
Zuletzt bearbeitet:
Bitte schön:
Code:
Dim sFinde As String, sVgl As String
Dim wksFinde As Worksheet, wksVgl As Worksheet
 
Sub woerter_finden()
 
Set wksFinde = Sheets("Tabelle1")
Set wksVgl = Sheets("Tabelle2")
 
'Suchbegriffe der Reihe nach durchlaufen'
For i = 1 To wksFinde.Range("A10000").End(xlUp).Row
 
  'Suchbegriff in Kleinbuchstaben in Variable speichern'
  sFinde = LCase(wksFinde.Range("A" & i).Value)
  
  'Vergleichsliste der Reihe nach durchlaufen'
  For k = 1 To wksVgl.Range("A10000").End(xlUp).Row
    
    'Vergleichswert in Kleinbuchstaben in Variable speichern'
    sVgl = LCase(wksVgl.Range("A" & k).Value)
    
    'Prüfen, ob der Suchbegriff am Anfang, Ende oder in der Mitte des Vergleichswertes vorkommt'
    If Left(sVgl, Len(sFinde) + 1) = sFinde & " " Or _
       Right(sVgl, Len(sFinde) + 1) = " " & sFinde Or _
       InStr(1, sVgl, " " & sFinde & " ", 1) Then
      
      'Zeilennummer k aus Vergleichsliste in Suchliste eintragen'
      'Wenn die Zelle noch leer ist, nur die Zeilennummer eintragen'
      If wksFinde.Range("B" & i) = "" Then
        wksFinde.Range("B" & i).Value = k
      'andernfalls die nächsten Zeilennummer hinten anhängen'
      Else
        wksFinde.Range("B" & i).Value = wksFinde.Range("B" & i).Value & ", " & k
      End If
      
    End If
 
  Next k
 
Next i
End Sub
 
Zurück
Oben