Macro: Suche nach einem Text Wert in einer Spalte 1 und kopieren Werte zu Spalte 2

Question

Hintergrund:

Spalte A in „Sheet1“ besteht aus mehr als 6.000 Zeilen von durch Komma in jeder Zeile getrennt Worte. Ich habe auch eine Suchworttabelle ("Sheet2").

Frage:

das Suchwort Table („Tabelle2“) besteht aus 24 Worten, die Ich mag würde von „Sheet1“ in Spalte A zu identifizieren und zu kopieren zu Spalte B derselben Tabelle über.

Das Problem, auf das ich gestoßen bin, ist, dass ich mit einer Reihe von Wörtern (24) zu tun habe, die ich jede Zeile gegen Spalte A überprüfen möchte, und ich bin mir nicht sicher, wie ich das einrichten soll .

Wenn der Text in einer Zelle in einem String überhaupt erscheint in Spalte A, sollte sie durch Kommas in Spalte B, getrennt in der gleichen Zeile ziehen. Nur der Text in der Suchwort-Tabelle sollte in Spalte B angezeigt

Bitte um Hilfe! diese

Answer 1

Versuchen:

Der einzige Nachteil dabei ist, dass Sie die Wörter eingeben müssen Sie suchen in das Array (siehe Word1, Wort2 etc.)

Sub movingvalues() 
Dim sht As Worksheet 
Dim i As Long 
Dim lastrow As Integer 

Set sht = ActiveWorkbook.Worksheets("Sheet1") 
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row 

Dim mywords As Variant, word As Variant 
mywords = Array("Word1", "Word2", "Word3", "Word4", "Word5") 'etc all the way to Word24 

ActiveWorkbook.Worksheets("Sheet1").Range("B:B").ClearContents 

For i = 1 To lastrow 
    For Each word In mywords 
     If InStr(ActiveWorkbook.Worksheets("Sheet1").Range("A" & i).Value, word) Then 
      If ActiveWorkbook.Worksheets("Sheet1").Range("B" & i).Value <> "" Then 
       ActiveWorkbook.Worksheets("Sheet1").Range("B" & i).Value = ActiveWorkbook.Worksheets("Sheet1").Range("B" & i).Value & " " & word 
      Else 
       ActiveWorkbook.Worksheets("Sheet1").Range("B" & i).Value = word 
      End If 
     End If 
    Next word 
Next i 
End Sub