Пользовательская форма для поиска двух критериев, а затем вставка данных строки в текстовые поля пользовательской формы - PullRequest
0 голосов
/ 05 ноября 2019

Я получаю ошибку во время выполнения '13': несоответствие типов для одной из строк, отмеченных ниже. Я хочу иметь пользовательскую форму, в которую можно ввести два критерия, затем она будет искать строку, содержащую оба этих критерия, и вставлять значения соответствующих ячеек в 11 текстовых полей пользовательской формы. Я не уверен, почему он дает мне ошибку для этой строки, или если есть лучший способ сделать это.

Private Sub CommandButton1_Click()

    txt1.Visible = True
    txt2.Visible = True
    txt3.Visible = True
    txt4.Visible = True
    txt5.Visible = True
    txt6.Visible = True
    txt7.Visible = True
    txt8.Visible = True
    txt9.Visible = True
    txt10.Visible = True
    txt11.Visible = True

    Dim ws As Worksheet
    Set ws = Sheets("The Goods")
    ws.Activate

    Dim SearchSearch As Variant
    SearchSearch = txtsearch.Value
    Dim SearchName As Variant
    SearchName = txtname.Value


        If Trim(txtsearch.Value) = "" Then
        MsgBox "Search can't be left blank.", vbOKOnly + vbInformation, "Search"
        End If
        If Trim(txtname.Value) = "" Then
        MsgBox "Name can't be left blank.", vbOKOnly + vbInformation, "Name"
        End If

    Dim FirstAddress As String, cF As Range

    With ThisWorkbook.Sheets("The Goods").Range("D:D") 'txtsearch will be in the range D:D

        Set cF = .Find(What:=SearchSearch, _
                       after:=ActiveCell, _
                       LookIn:=xlValues, _
                       LookAt:=xlPart, _
                       SearchOrder:=xlByColumns, _
                       SearchDirection:=xlNext, _
                       MatchCase:=False, _
                       SearchFormat:=False) ' line that is giving me an error

     With ThisWorkbook.Sheets("The Goods").Range("B:B") 'txtname will be in the range B:B

        Set cF = .Find(What:=SearchName, _
                       after:=ActiveCell, _
                       LookIn:=xlValues, _
                       LookAt:=xlPart, _
                       SearchOrder:=xlByColumns, _
                       SearchDirection:=xlNext, _
                       MatchCase:=False, _
                       SearchFormat:=False)

        txt1.Value = cF.(0, 5).Value 
        txt2.Value = cF(0, 3).Value 
        txt3.Value = cF(0, 6).Value 
        txt4.Value = cF(0, 7).Value 
        txt5.Value = cF(0, 8).Value 
        txt6.Value = cF(0, 9).Value 
        txt7.Value = cF(0, 10).Value 
        txt8.Value = cF(0, 11).Value 
        txt9.Value = cF(0, 12).Value
        txt10.Value = cF(0, 13).Value 
        txt11.Value = cF(0, 14).Value 

    End With
End With

End Sub

Private Sub CommandButton3_Click()
Dim iExit As VbMsgBoxResult
iExit = MsgBox("Are you sure you want to exit?", vbQuestion + vbYesNo, "Search System")

If iExit = vbYes Then
Unload Me
End If
End Sub

Ответы [ 2 ]

1 голос
/ 06 ноября 2019

Код ниже представляет собой простой For Loop, который проходит через каждый cel в Column B и проверяет на txtname.Value, и использует смещение, чтобы проверить, равно ли Column D значение txtsearch.Value. Если оба совпадения совпадают, то значения этой строки будут записаны в текстовые поля userform. Вы можете изменить TextBox1 на txt1 и т. Д.

Private Sub CommandButton1_Click()
Dim ws As Worksheet, cel As Range

Set ws = Sheets("The Goods")


    For Each cel In ws.Cells(2, 2).Resize(ws.Cells(Rows.Count, 2).End(xlUp).Row).Cells

        If cel.Value = Me.txtname.Value And cel.Offset(, 2).Value = Me.txtsearch.Value Then

            Me.TextBox1.Value = cel.Offset(, 3).Value 'Change to your textbox naming scheme
            Me.TextBox2.Value = cel.Offset(, 1).Value
            Me.TextBox3.Value = cel.Offset(, 4).Value
            Me.TextBox4.Value = cel.Offset(, 5).Value
            Me.TextBox5.Value = cel.Offset(, 6).Value
            Me.TextBox6.Value = cel.Offset(, 7).Value
            Me.TextBox7.Value = cel.Offset(, 8).Value
            Me.TextBox8.Value = cel.Offset(, 9).Value
            Me.TextBox9.Value = cel.Offset(, 10).Value
            Me.TextBox10.Value = cel.Offset(, 11).Value
            Me.TextBox11.Value = cel.Offset(, 12).Value

        End If

    Next cel
End Sub
0 голосов
/ 05 ноября 2019

Я бы пошел с чем-то вроде этого:

Private Sub CommandButton1_Click()

    Dim i As Long, rngB As Range, n As Long, arrB, arrD
    Dim ws As Worksheet
    Dim SearchSearch As Variant, SearchName As Variant

    For i = 1 To 11
        Me.Controls("txt" & i).Visible = True
    Next i

    Set ws = ThisWorkbook.Sheets("The Goods")
    ws.Parent.Activate
    ws.Activate

    SearchSearch = Trim(txtsearch.Value)
    SearchName = Trim(txtname.Value)

    'check the trimmed values
    If Len(SearchSearch) = 0 Or Len(SearchName) = 0 Then
        MsgBox "'Search' and 'Name' can't be left blank.", vbOKOnly + vbInformation, "Search"
        Exit Sub
    End If

    'get search ranges
    Set rngB = ws.Range(ws.Range("B1"), ws.Cells(ws.Rows.Count, "B").End(xlUp))
    Set rngD = rngB.Offset(0, 2)

    'pull the values into a couple of arrays for faster searching
    arrB = rngB.Value
    arrD = rngD.Value

    'loop over the arrays
    For n = 1 To UBound(arrB, 1)
        If arrB(n, 1) = SearchName And arrD(n, 1) = SearchSearch Then
            'got a hit - populate your textboxes

            Set cF = rngB.Cells(n, 1)
            txt1.Value = cF.Offset(0, 1).Value  'Col C same row
            txt2.Value = cF.Offset(0, 2).Value  'Col D same row
            txt3.Value = cF.Offset(0, 3).Value  'Col E same row
            'etc etc

            'OR do something like this:

            With rngB.Cells(n, 1).EntireRow
                txt1.Value = .Cells(1, "C").Value
                txt1.Value = .Cells(1, "D").Value
                txt1.Value = .Cells(1, "E").Value
                'etc etc
            End With


            Exit For
        End If
    Next

    If cF Is Nothing Then MsgBox "No match!"

End Sub
...