Question

我试图自动化一个在A和B列都有标题的Excel文件，我必须在B中搜索A中的每个单词。如果有任何单词匹配，那么我需要在可用的B列之后粘贴它（C ，D，...）在同一行。

我使用下面的代码，我将在A列标题的单独列中手动分隔单词并在B列中搜索：

Sub macro1()
Application.ScreenUpdating = False
Dim col As Range, cell1 As Range, a As String, b As String, i As Integer
Set col = Range("KW[KW1]")
Dim target, cell As Range
Sheets("Data").Select
Set target = Range(Range("B1"), Range("B65536").End(xlUp))
Dim term, tag As String
    For Each cell1 In col
    a = cell1.Value

    term = a
    tag = a

        For Each cell In target
            b = cell.Value

          If Module1.ExactWordInString(b, a) Then
                For i = 1 To 15
                    If cell.Offset(0, i).Value = "" Then
                    cell.Offset(0, i).Value = tag
                    Exit For
                    End If
                Next i

        End If

        Next cell
    Next cell1
     Application.ScreenUpdating = True
End Sub

我期待输出：

Column A          Column B                    Column C  Column D
Title 1           Title 2       
XXX YYY zzz aaa   asdbfjk XXX yyy sfkbvskdf     XXX       yyy

显然它花了这么多时间，有人能帮帮我吗？

Answer 1

基于已经讨论过的内容并基于MathewD建议使用拆分功能。我会将每个单元格拆分成一个数组，然后遍历这些数组以找到匹配项，然后使用偏移量和计数器将匹配项放入各个单元格中以移动到下一列。像这样：

Dim a() As String
Dim b() As String
Dim aRng As Range
Dim cel As Range
Dim i As Integer, t As Integer, clm As Integer

Set aRng = Range(Range("KW1"), Range("KW1").End(xlDown))

For Each cel In aRng
    a = Split(cel, " ")
    b = Split(cel.Offset(, 1), " ")
    clm = 2

    For i = LBound(a) To UBound(a)
        For t = LBound(b) To UBound(b)
            If a(i) = b(t) And a(i) <> "" Then
                cel.Offset(, clm) = a(i)
                clm = clm + 1
            End If
        Next
    Next

Next

如果您不希望区分大小写，则将区分大小写，然后将if语句更改为此

If UCase(a(i)) = UCase(b(t)) And a(i) <> "" Then

将标题分为单词并在标题中搜索

1 个答案: