VBA -Как правильно найти, скопировать и вставить поиск с помощью кнопки на пользовательской форме? - PullRequest
0 голосов
/ 03 февраля 2019

Мне нужно какое-то направление относительно того, что может быть не так с кодом VBA, который я использую.Я работал над этим часами и не могу понять, что происходит.На данный момент, когда я запускаю код, ничего не происходит, нет ошибок, ничего…

Много кода, который я использую, я получил из этого поста: Аналогичный пример использования

Любая помощь будет принята с благодарностью.

Что я пытаюсь сделать:

Я пытаюсь найти в базе данных значения в текстовых полях в пользовательской форме при нажатии кнопки команды.Другими словами, я говорю vba выполнить поиск по строкам данных и сопоставить значения в текстовых полях, а затем, если есть совпадение, скопировать это совпадение на новый лист.

Процесс:

  1. Создание события щелчка для кнопки «Выполнить проверку» в коде пользовательской формы
  2. Очистка целевой области листа перед каждым выполнением (каждый щелчок).
  3. Установить массив из значений текстового поля, где индекс каждого совпадает с номером столбца для поиска (хотя я ищу только 2 значения в массиве, я хочу основываться на этом позже, чтобы массив имел смысл)
  4. Фильтр поиска только строк, которые имеют статус «Открыть» в столбце состояния
  5. Одна строка за раз, сравнивает значение соответствующего столбца с индексом массива, который ему соответствует
  6. Если совпадение найдено, переменная «match» устанавливается в значение true
  7. Проходить по остальным значениям текстовых полей из массива, если ЛЮБОЙ из них не совпадает, «соответствует»Переменная установлена ​​в false и прерывает цикл над текстовыми полями как сбой.
  8. Если «match» равно true, то к концу цикла через строку «искомого» листа столбцы с 1 по 8 получаютпетляПролистав, установив значения из искомого листа в целевой лист.
  9. Конец цикла Nest Row

Снимки экрана, чтобы помочь с контекстом

Шаг 1

Шаг 2

Шаг 3

Шаг 4

Код Обновлен <- Работает: </p>

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)
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 'changed from  to 3
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) 'changed from 9 to 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

1 Ответ

0 голосов
/ 03 февраля 2019

Не проверено:

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)
    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("A8:F" & wsSyn.Range("A" & Rows.Count).End(xlUp).Row + 1).ClearContents
    tRow = 3 '<< but you clear from row 8 down?

    '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(9) = dirquote_box.Text       'Column "I" (9)

    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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...