宏：搜索在列1中的文本值和複製值至第2列

Question

背景：在「工作表Sheet」

柱A由6,000+行由逗號每行中分隔的單詞。我也有一個搜索詞表（「Sheet2」）。

問：

檢索詞表（「Sheet2的」）由24個字，我想從「工作表Sheet1」在列A識別和複製到同一個電子表格的B列。

我遇到的問題是我正在處理一系列的單詞（24），我想交叉檢查列A中的每一行，並且我不確定如何設置該單詞。

如果文本全部出現在A列單元格中的一個字符串中，它應該拉入B列中的相同行，並用逗號分隔。只有搜索字表中的文本應該出現在列B中。

請幫忙！

Answer 1

試試這個：

這個唯一的缺點是，你必須輸入你要找的爲陣列的字（見字1，字2等）

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