поиск комбинации слов в листе с использованием VBA

Question

Мне нужно найти строку, которая в виде комбинации слов (Ключевое слово - Столбец 1, Ключевое слово 2 - Столбец 2, Ключевое слово 3 - Столбец 3) листа 1 с листом 2, который содержит более 800 строк и 275 столбцов.

Я сделал кодирование, но оно дает результат как "не отвечает". Пожалуйста, помогите мне разобраться с этой проблемой.

ниже кодировка: -

Private Sub CommandButton1_Click()

Dim keyword As String
Dim keyword1 As String
Dim keyword2 As String
Dim keyword3 As String
Dim k As Long
Dim k1 As Long

Application.ScreenUpdating = False


Set XML = ThisWorkbook.Worksheets("XML")
Set rn = XML.UsedRange

k = rn.Rows.Count + rn.Row - 1
Debug.Print (k)
For i = 1 To k

k1 = rn.Columns.Count + rn.Column - 1
Debug.Print (k1)
For j = 1 To k1

cellAYvalue = XML.Cells(i, j)

For a = 2 To 261

MatchAttempt = 0

keyword_Flag = False
keyword1_Flag = False
keyword2_Flag = False
keyword3_Flag = False
keyword4_Flag = False
keyword5_Flag = False

keyword = Trim(UCase(ThisWorkbook.Worksheets("Keyword").Cells(a, 2)))
keyword1 = Trim(UCase(ThisWorkbook.Worksheets("Keyword").Cells(a, 3)))
keyword2 = Trim(UCase(ThisWorkbook.Worksheets("Keyword").Cells(a, 4)))
keyword3 = Trim(UCase(ThisWorkbook.Worksheets("Keyword").Cells(a, 5)))
keyword4 = Trim(UCase(ThisWorkbook.Worksheets("Keyword").Cells(a, 6)))
keyword5 = Trim(UCase(ThisWorkbook.Worksheets("Keyword").Cells(a, 7)))

If keyword <> "" Then
    keyword_Flag = True: MatchAttempt = MatchAttempt + 1
End If
If keyword1 <> "" Then
    keyword1_Flag = True: MatchAttempt = MatchAttempt + 1
End If
If keyword2 <> "" Then
    keyword2_Flag = True: MatchAttempt = MatchAttempt + 1
End If
If keyword3 <> "" Then
    keyword3_Flag = True: MatchAttempt = MatchAttempt + 1
End If
If keyword4 <> "" Then
    keyword4_Flag = True: MatchAttempt = MatchAttempt + 1
End If
If keyword5 <> "" Then
    keyword5_Flag = True: MatchAttempt = MatchAttempt + 1
End If


        MatchedCount = 0

        Description = Trim(UCase(cellAYvalue = XML.Cells(i, j)))
        Description1 = Trim(UCase(cellAYvalue = XML.Cells(i, j)))
        Description2 = Trim(UCase(cellAYvalue = XML.Cells(i, j)))
        Description3 = Trim(UCase(cellAYvalue = XML.Cells(i, j)))
        Description4 = Trim(UCase(cellAYvalue = XML.Cells(i, j)))
        Description5 = Trim(UCase(cellAYvalue = XML.Cells(i, j)))
        EXITloop = Trim(UCase(ThisWorkbook.Worksheets("Keyword").Cells(a, 1)))

        If EXITloop = "" Then
        Exit For
        End If


              MatchComplete = False

              If keyword_Flag = True Then
                If keyword = Description Then
                    MatchedCount = MatchedCount + 1
                    If MatchAttempt = MatchedCount Then MatchComplete = True
                End If
              End If
                If keyword_Flag1 = True Then
                If keyword1 = Description1 Then
                    MatchedCount = MatchedCount + 1
                    If MatchAttempt = MatchedCount Then MatchComplete = True
                End If
              End If
              If keyword_Flag2 = True Then
                If keyword2 = Description2 Then
                    MatchedCount = MatchedCount + 1
                    If MatchAttempt = MatchedCount Then MatchComplete = True
                End If
              End If
              If keyword_Flag3 = True Then
                If keyword3 = Description3 Then
                    MatchedCount = MatchedCount + 1
                    If MatchAttempt = MatchedCount Then MatchComplete = True
                End If
              End If
              If keyword_Flag4 = True Then
                If keyword4 = Description4 Then
                    MatchedCount = MatchedCount + 1
                    If MatchAttempt = MatchedCount Then MatchComplete = True
                End If
              End If
              If keyword_Flag5 = True Then
                If keyword5 = Description5 Then
                    MatchedCount = MatchedCount + 1
                    If MatchAttempt = MatchedCount Then MatchComplete = True
                End If
              End If


                inin = Trim(UCase(ThisWorkbook.Worksheets("XML").Cells(i, 112)))
                ouou = Trim(UCase(ThisWorkbook.Worksheets("Keyword").Cells(a, 8)))


            If MatchComplete = True Then

                    ouou = inin

            End If


a = a + 0

Next

j = j + 0

Next

i = i + 0

Next

Application.ScreenUpdating = True

MsgBox "Completed"

End Sub

---

Редактировать: Подробнее

---

У меня есть рабочая тетрадь с двумя листами

В листе 1 содержится «N» количество данных с 807 строками и 277 столбцами

На листе 2 установлена ​​стандартная комбинация ключевых слов (201 комбинация).

Примечание: - каждая комбинация из листа 2 может быть доступна в любом ряду или столбцах листа 1, но комбинация должна быть только в одной строке.

Требования: - Нужно найти комбинацию ключевых слов из листа 2 на листе 1, после того как комбинация, найденная на листе 1, нам нужна для получения результата.

Лист 1 (Data Sheet)

Лист 2 (Лист ключевых слов)

Поиск ключевых слов из листа 2 в листе 1

ключевые слова можно найти во многих ячейках листа 1 (выделены желтым цветом), но комбинация будет найдена только в одной строке, и нам нужно найти эту строку (выделено зеленым цветом)

как только мы нашли строку на листе 1, в которой есть комбинация, нам нужно извлечь четвертое значение из последнего слова комбинации и вставить его в 10-й столбец листа 2.

1062 * например *

в листе 1

мы нашли комбинацию 100-й ряд

в этой строке ключевое слово 1 в (100,20) Ключевое слово 2 в (100,40) ключевое слово 3 in (100,60)

, тогда для вывода необходимо скопировать значение из ячейки (100,64) на листе 1, а затем вставить в 10-й столбец листа 2 в соответствующий комбинированный ряд на листе 2.

Answer 1

Идентифицирует Sheet2 строк в Sheet1, основываясь на первых трех столбцах в качестве ключевых слов.

Как только запись найдена, она копирует значение из 3-го столбца в Sheet1 в 10-м столбцеSheet2

---

Option Explicit

Private Sub CommandButton1_Click()

    Const FR = 2    'Start row
    Const KC = 3    'Last Keyword column
    Const TC = 10   'Target column

    Dim ws1 As Worksheet:   Set ws1 = Sheet1    'Or: ThisWorkbook.Worksheets("Sheet1")
    Dim ws2 As Worksheet:   Set ws2 = Sheet2

    Dim lr1 As Long:        lr1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    Dim lr2 As Long:        lr2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

    Dim arr1 As Variant:    arr1 = ws1.Range(ws1.Cells(FR, 1), ws1.Cells(lr1, KC))
    Dim arr2 As Variant:    arr2 = ws2.Range(ws2.Cells(FR, 1), ws2.Cells(lr2, KC))

    Dim d1 As Object:       Set d1 = CreateObject("Scripting.Dictionary")
    Dim d2 As Object:       Set d2 = CreateObject("Scripting.Dictionary")
    Dim dr As Object:       Set dr = CreateObject("Scripting.Dictionary")   'Result

    LoadDictionary d1, arr1
    LoadDictionary d2, arr2
    GetKeywords d2, d1, dr

    Dim r As Long

    arr2 = ws2.Range(ws2.Cells(FR, 1), ws2.Cells(lr2, TC))
    If dr.Count > 0 Then
        For r = 1 To lr2
            If dr.Exists(r) Then arr2(r, TC) = arr2(r, KC)  'Or arr2(r, TC) = dr(r)
        Next
    End If
    ws2.Range(ws2.Cells(FR, 1), ws2.Cells(lr2, TC)) = arr2
End Sub

---

Private Sub LoadDictionary(ByRef d As Object, arr As Variant)   'Expects 2-d array

    Dim r As Long, c As Long, k As String

    For r = 1 To UBound(arr, 1)
        k = "|"
        For c = 1 To UBound(arr, 2)
            k = k & arr(r, c) & "|"     'Concatenate all columns
        Next
        d(k) = r
    Next
End Sub

Private Sub GetKeywords(ByRef d1 As Object, ByRef d2 As Object, ByRef dr As Object)

    Dim r As Long, k As String, arr As Variant

    For r = 0 To d1.Count - 1
        k = d1.Keys()(r)
        If d2.Exists(k) Then
            arr = Split(k, "|")
            dr(d1(k)) = arr(UBound(arr) - 1)
        End If
    Next
End Sub

---

.

Тест Sheet 1

Тест Sheet 2

---

Sheet1 Rows: 1,001, Cols: 501; Sheet2 Rows: 1,001, Cols: 501 - Time: 0.023 sec

Новая информация:

Строка 1 - Ключевое слово 1, Ключевое слово 2, Ключевое слово 3 (как только мы найдем строку с этим порядком, нам нужно получить 4-е значение из ключевого слова 3 втот же ряд) и вставьте в 10 столбец листа 2