Разделение заголовка на слова и поиск в другом заголовке

Question

Я пытался автоматизировать файл Excel с заголовком в столбцах A и B, и мне нужно искать каждое слово из A в B. Если какие-либо слова совпадают, мне нужно вставить его после доступного столбца 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

но он повторяет повторяющиеся слова снова и снова, если таковые имеются. Есть ли способ избежать дублирования слов? Пожалуйста, помогите мне.

Answer 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

Answer 2

Sub percentage()

Dim a() As String Dim b() As String Dim aRng Как диапазон Dim cel Как диапазон Dim i Как целое число, t Как целое число, clm Как целое число Установите aRng = Range(Range("A1"), Range("A65536") ,End (xlDown))

Для каждого cel In aRng a = Split(cel, "") b = Split(cel.Смещение (, 1), "") d = 0 clm = 2 C = UBound (a) Если cel.Значение <> "" Тогда для i = LBound (a) до 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.Смещение (0, 2).Значение = (d / c) End If Next

End Sub`