☰

将标题分成几个单词，然后在另一个标题中搜索

tag-icon • tag-icon microsoft-excel microsoft-excel-2007 vba
将标题分成几个单词，然后在另一个标题中搜索

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

我正在使用下面的代码，我将在 A 列标题的单独列中手动分离单词，然后在 B 列中搜索它。

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 UCase(a(i)) = UCase(b(t)) Then
                cel.Offset(, clm) = a(i)
                clm = clm + 1
            End If
        Next
    Next

Next

但它重复了重复的单词（如果有的话）。有没有办法避免重复的单词？请帮帮我。

答案1

这实际上并不是最干净的方法，但您可以通过从偏移量 2 开始循环检查每个已填充的单元格，直到到达空单元格。请注意，此代码未经测试。

For i = LBound(a) To UBound(a)
    For t = LBound(b) To UBound(b)
        If UCase(a(i)) = UCase(b(t)) Then
            clm = 2
            Do While True
                If UCase(cel.Offset(, clm)) = UCase(a(i)) Then
                    Exit Do
                End If
                If cel.Offset(, clm) = "" Then
                    cel.Offset(, clm) = a(i)
                    Exit Do
                End If
                clm = clm + 1
            Loop
        End If
    Next
Next

答案2

Sub percentage()

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("A1"), Range("A65536").End(xlDown))

For Each cel In aRng a = Split(cel, " ") b = Split(cel.Offset(, 1), " ") d = 0 clm = 2 C = UBound(a) If cel.Value <> "" Then For i = LBound(a) To UBound(a)

        For t = LBound(b) To UBound(b)
            If UCase(a(i)) = UCase(b(t)) Then
                clm = 2
             Do While True
                If UCase(cel.Offset(, clm)) = UCase(a(i)) Then
                Exit Do
                End If
                    If cel.Offset(, clm) = "" Then
                        'cel.Offset(, clm) = a(i)
                        Exit Do
                    End If
                    clm = clm + 1
                Loop
                d = d + 1
            End If

        Next

Next

`MsgBox "总单词数" & C & "匹配单词数" & d'cel.Offset(0, 2).Value = (d / c) End If Next

结束子程序`

相关内容