Question

嗨，我有一个用户窗体，我可以在文本框中键入条形码和该项目的描述，它将显示结果...但是在我的代码中，我只能搜索第一列...我希望所有列要在文本框中搜索的表格，我有8列

Private Sub TextBox1_Change()
    Me.TextBox1.text = StrConv(Me.TextBox1.text, vbProperCase)
    Dim i As Long
    Me.ListBox1.Clear
    On Error Resume Next
    For i = 1 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
      a = Len(Me.TextBox1.text)
      If Left(Sheet1.Cells(i, 1).text, a) = Left(Me.TextBox1.text, a) Then
        Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 7) = Sheet1.Cells(i, 8).Value

      End If
    Next i
End Sub

Answer 1

尝试此代码。...

  Private Sub TextBox1_Change()
    Me.TextBox1.Text = StrConv(Me.TextBox1.Text, vbProperCase)
    Dim i, x As Long
    Me.ListBox1.Clear
    On Error Resume Next
    For i = 1 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
      a = Len(Me.TextBox1.Text)
      For x = 1 To 8
      If Left(Sheet1.Cells(i, x).Text, a) = Left(Me.TextBox1.Text, a) Then
       Me.ListBox1.AddItem Sheet1.Cells(i, 1).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Sheet1.Cells(i, 3).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 3) = Sheet1.Cells(i, 4).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sheet1.Cells(i, 5).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 5) = Sheet1.Cells(i, 6).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 6) = Sheet1.Cells(i, 7).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 7) = Sheet1.Cells(i, 8).Value
      End If
      Next
    Next i
End Sub

Answer 2

更快地尝试此代码...

Private Sub TextBox1_Change()
    Dim myArray, lr, x, i
    Dim DATA As Worksheet
    Set DATA = Worksheets("Sheet1")
    lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row
    ListBox1.Clear
    If TextBox1.Text = "" Then Exit Sub
    myArray = DATA.Range("A2:H" & lr + 1)
    ReDim y(1 To UBound(myArray) * 8, 1 To 8)
    For i = LBound(myArray) To UBound(myArray)
     a = Len(Me.TextBox1.Text)
     For x = 1 To 8
     If Left(myArray(i, x), a) = Left(TextBox1.Text, a) Then
            rw = rw + 1
            For yy = 1 To 8
                y(rw, yy) = myArray(i, yy)
            Next yy
        End If
        Next
    Next i
    If rw > 0 Then
        ListBox1.List = y()
    End If
End Sub

但是一次搜索所有列需要时间，但这是个主意

click here

VBA搜索文本框和填充列表框

2 个答案: