宏：搜索在列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