Сопоставление 1D-массива прерывается, когда данные существуют в строках выше соответствующих данных в электронной таблице

Question

У меня есть кнопка на пользовательской форме, которая будет сопоставлять строки из двух текстовых полей с данными в определенных столбцах на листе «База данных», если совпадение будет найдено, она копирует строку на другой лист.

Код работает и сопоставляет данные с листа, когда сопоставленные данные являются «первыми» в базе данных.Это означает, что данные о совпадении могут находиться в строках 1, 2, 3, 10, но до тех пор, пока НЕТ данных существует, прежде чем совпадение сработает.

Проблема: разрывы соответствия, когда данные существуют в строках выше соответствующих критериев.Я получаю ответное возвращение False, когда оно должно быть True.Когда я перемещаю данные в «первые» данные, они работают.

Снимки экрана, которые помогут проиллюстрировать:

Критерии соответствия

- Работы -

Возвращает True для местных жителей

- Перерывы -

Ошибка совпадения Возвращает Falseв Locals

Я использую массив, который выстраивает индексы по столбцам, которые я ищу, поэтому мне не нужно сортировать данные.Но я попытался разобраться, и возникла та же проблема.Я также удостоверился, что все ячейки в диапазоне, который я ищу, имеют формат "Общий", на всякий случай.Я не "вижу", что еще это может быть?Любая помощь будет принята с благодарностью.

Private Sub run_check_but_Click()
    Const COL_STATUS As Long = 4
    Dim wsData As Worksheet, wsSyn As Worksheet
    Dim tRow As Long, i As Long
    Dim tempList(1 To 9) As String
    Dim match As Boolean
    Dim rCol As Range, c As Range

    Set wsData = Sheets("Database")
    Set rCol = wsData.Range(wsData.Cells(3, 4), wsData.Cells(100, 4))

    'Set TargetSheet and clear the previous contents
    Set wsSyn = Sheets("Syn_Calc")
    wsSyn.Range("A3:G" & wsSyn.Range("A" & Rows.count).End(xlUp).row + 1).ClearContents
    tRow = 3

    'Set an array of strings, based on the index matching the column to search for each
    tempList(5) = curbase_box.Text      'Column "E" (5)
    tempList(6) = dirquote_box.Text     'Column "F" (6)

    For Each c In rCol.Cells
        With c.EntireRow
            If .Cells(COL_STATUS).Value = "Open" Then

                match = False

                For i = LBound(tempList) To UBound(tempList)
                    If tempList(i) <> "" Then
                        match = (.Cells(i).Text = tempList(i))
                        If Not match Then Exit For
                    End If
                Next i

                If match Then
                    'copy values from E-K
                    wsSyn.Cells(tRow, 1).Resize(1, 7).Value = _
                         .Cells(5).Resize(1, 7).Value
                    tRow = tRow + 1
                End If

            End If 'open
        End With
    Next c
End Sub 

Ожидаемые результаты: Когда я нажимаю на командную кнопку, она выполняет поиск по столбцам для сопоставления строк в текстовых полях, независимо от того, где находятся данные в столбцах, и копирует строку соответствия на другой лист.

Примечание. Код будет искать совпадение только в том случае, если 4-й столбец («D») имеет статус «Открыть», как вы видели в коде.Я подтвердил, что это прекрасно работает.

Answer 1

Я добавил несколько строк отладки и еще один цикл.Посмотри!Проверьте также вывод в непосредственном окне (Ctrl G)!

Пример вывода в непосредственном окне:

rCol.Address: $D$2:$D$9

start in $D$6
search for CHF
--- search in $E$6
--- search in $F$6
--- search in $G$6
--- search in $H$6
search for 12342
--- search in $E$6
--- search in $F$6
--- search in $G$6
--- search in $H$6

start in $D$7
search for CHF
--- search in $E$7
--- search in $F$7
--- search in $G$7
--- search in $H$7
==============> Match in $H$7

...
...
...

База данных

Syn_Calc

Option Explicit

Sub test()
Dim c As Range
Dim COL_STATUS As Integer
Dim Match As Boolean
Dim i As Integer
Dim j As Integer
Dim TempList(10) As String
Dim tRow
Dim wsSyn As Worksheet
Dim wsDAta As Worksheet
Dim rCol As Range
Dim MatchRef As String

COL_STATUS = 4

Set wsDAta = Sheets("Database")
Set rCol = wsDAta.Range(wsDAta.Cells(2, 4), wsDAta.Cells(9, 4))
Debug.Print "rCol.Address: "; rCol.Address

'Set TargetSheet and clear the previous contents
Set wsSyn = Sheets("Syn_Calc")
wsSyn.Range("A3:G" & wsSyn.Range("A" & Rows.Count).End(xlUp).Row + 1).ClearContents
tRow = 3

'Set an array of strings, based on the index matching the column to search for each
TempList(5) = "CHF" 'curbase_box.Text      'Column "E" (5)
TempList(6) = "12342" 'dirquote_box.Text     'Column "F" (6)

    For Each c In rCol.Cells

    'Set c = Range("A2")
    With c.EntireRow
            If .Cells(COL_STATUS).Value = "Open" Then

                Match = False
                MatchRef = ""
                Debug.Print
                Debug.Print "start in "; c.Address

                For i = LBound(TempList) To UBound(TempList)
                    If TempList(i) <> "" Then
                        Debug.Print "search for "; TempList(i)
                        For j = 5 To 8 'Col E to H
                            Debug.Print "--- search in "; .Cells(1, j).Address
                            Match = (.Cells(1, j).Text = TempList(i))
                            If Match Then
                                'debug: matchRef info
                                MatchRef = "match in " & .Cells(1, j).Address & " - Value : " & TempList(i)
                                Debug.Print "==============> Match in "; .Cells(1, j).Address
                                Exit For
                            End If
                        Next j
                    If Match Then Exit For
                    End If
                Next i

                If Match Then
                    'copy values from E-K
                    wsSyn.Cells(tRow, 1).Resize(1, 7).Value = _
                         .Cells(5).Resize(1, 7).Value
                    'debug: matchRef info
                    wsSyn.Cells(tRow, 9).Value = MatchRef
                    tRow = tRow + 1
                End If

            End If 'open
        End With
    Next c
End Sub