Соответствие нескольким критериям / индекс VBA на двух листах - PullRequest
0 голосов
/ 06 января 2020

Многокритериальный индекс / соответствие VBA на двух листах в одной книге

Итак, в основном у меня есть 2 листа в одной книге

Лист 1 выглядит следующим образом:

enter image description here

Лист 2 выглядит следующим образом: enter image description here

Я хочу сопоставить раздел комментариев на основе PO / SO AND Активность с использованием VBA вместо формулы.

Ниже приведен код, который я пытался написать, но он не работает ...

Dim ID As String, Activity As String

    For r = 2 To ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count

    ID = ThisWorkbook.Worksheets("Sheet1").Cells(r, 1).Value
    Activity = ThisWorkbook.Worksheets("Sheet1").Cells(r, 2).Value

        For s = 2 To ThisWorkbook.Worksheets("Sheet2").UsedRange.Rows.Count

            If ThisWorkbook.Worksheets("Sheet2").Cells(s, 1).Value = ID And ThisWorkbook.Worksheets("Sheet2").Cells(s, 2).Value = Activity Then
                ThisWorkbook.Worksheets("Sheet2").Cells(s, 3).Value = ThisWorkbook.Worksheets("Sheet1").Cells(s, 3).Value
            End If

        Next s
    Next r

Если я попытаюсь запустить код, я не получу никаких предупреждений об ошибках, но больше ничего не произойдет ни ... ни сообщений об ошибках, ни каких-либо реакций. Я дважды проверил все имена, номера столбцов и все

Ответы [ 2 ]

2 голосов
/ 06 января 2020

Привет Эмма. Предположим, что ваш лист 1 и ваш лист 2 имеют одинаковую линейку столбцов.

Sub findMatch()

Dim ID As String
Dim Activity As String

For r = 2 To ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count
    ID = ThisWorkbook.Worksheets("Sheet1").Cells(r, 1).Value
    Activity = ThisWorkbook.Worksheets("Sheet1").Cells(r, 2).Value

     For s = 2 To ThisWorkbook.Worksheets("Sheet2").UsedRange.Rows.Count

    If ThisWorkbook.Worksheets("Sheet2").Cells(s, 1).Value = ID And ThisWorkbook.Worksheets("Sheet2").Cells(s, 2).Value = Activity Then
        ThisWorkbook.Worksheets("Sheet2").Cells(s, 4).Value = ThisWorkbook.Worksheets("Sheet1").Cells(s, 3).Value
    End If

    Next s
        Next r
End Sub

Это код, который вы представили выше, и он отлично сработал для меня. Я сделал небольшое изменение, чтобы проверить себя только на этой линии.

ThisWorkbook.Worksheets("Sheet2").Cells(s, 4).Value = ThisWorkbook.Worksheets("Sheet1").Cells(s, 3).Value

вот моя рабочая тетрадь. лист 1 и лист 2. Однако я предупреждаю, что поиск соответствия в этом порядке может быть проблематичным. Я бы предпочел использовать функцию поиска и l oop лист 2. enter image description here

enter image description here

2 голосов
/ 06 января 2020

У меня не было проблем с вашим кодом, за исключением необходимости изменить эту строку ...

ThisWorkbook.Worksheets("Sheet2").Cells(s, 3).Value = ThisWorkbook.Worksheets("Sheet1").Cells(s, 3).Value

На

ThisWorkbook.Worksheets("Sheet2").Cells(s, 3).Value = ThisWorkbook.Worksheets("Sheet1").Cells(r, 3).Value
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...