excel 从文本框中查找用户窗体上的值,并在列表框中显示结果

k2fxgqgv  于 2023-06-07  发布在  其他
关注(0)|答案(1)|浏览(220)

我有一个Excel工作表,它有A列,搜索值将在其中,它应该从B列检索结果,代码应该每当我在textbox(txtreg)中输入一个值时,都会在Listbox(txtledglist)中获得结果,可能是1个或多个结果,最多6个。
我的代码是这样的:每当我键入的搜索值,只有1个结果带来了罚款,但当它有多个结果,它得到它,但需要超过5分钟和somtimes excel崩溃,这是真的unsuall。或者当我删除搜索值试图输入一个新的它也崩溃,当我检查VBA我看到代码不断运行,这是导致Excel崩溃。
有什么想法让代码更简单或者我做错了什么?
谢谢。

Private Sub txtreg_Change()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lookupValue As String
    Dim results() As Variant
    Dim rng As Range
    Dim cell As Range
    Dim index As Long
    Dim count As Long
    

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("L 403")
    

    lookupValue = txtreg.Value
    
    txtledglist.Clear
    
    Set rng = ws.Range("A:B")
    On Error Resume Next
    Set cell = rng.Columns(1).Find(What:=lookupValue, LookIn:=xlValues, LookAt:=xlWhole)
    On Error GoTo 0
    
    If Not cell Is Nothing Then
        count = 0
        Do
            count = count + 1
            ' Find the next match
            Set cell = rng.Columns(1).FindNext(cell)
        Loop While Not cell Is Nothing And cell.Address <> rng.Columns(1).Find(What:=lookupValue, After:=cell, LookIn:=xlValues, LookAt:=xlWhole).Address
        
        ReDim results(1 To count)
        
        Set cell = rng.Columns(1).Find(What:=lookupValue, LookIn:=xlValues, LookAt:=xlWhole)
        
        index = 1
        Do
            results(index) = rng.Columns(2).Cells(cell.Row - rng.Cells(1).Row + 1).Value ' Adjusting for header row
            index = index + 1
            Set cell = rng.Columns(1).FindNext(cell)
        Loop While Not cell Is Nothing And cell.Address <> rng.Columns(1).Find(What:=lookupValue, After:=cell, LookIn:=xlValues, LookAt:=xlWhole).Address
        
        txtledglist.List = results
       
    End If

End Sub
uqcuzwp8

uqcuzwp81#

首先,您应该保存找到的第一个单元格,这样就不必再次调用.Find,这将重新启动搜索。另外,您不需要在循环条件中与Nothing进行比较。
第二,我不清楚地理解带有注解“调整标题行”的行。无论如何,没有必要进行调整:两个单元在同一行中。
更正代码:

Private Sub txtreg_Change()
    Dim lookupValue As String: lookupValue = txtreg.Value
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Sheets("L 403")
    
    txtledglist.Clear
    
    Dim rng As Range: Set rng = ws.Range("A:B")
    On Error Resume Next
    Dim firstCell As Range: Set firstCell = rng.Columns(1).Find(What:=lookupValue, LookIn:=xlValues, LookAt:=xlWhole)
    On Error GoTo 0
    
    If Not firstCell Is Nothing Then
        Dim cell As Range: Set cell = firstCell
        Dim count As Long: count = 0
        Do
            count = count + 1
            Set cell = rng.Columns(1).FindNext(cell)
        Loop While cell.Address <> firstCell.Address
        
        Dim results() As Variant: ReDim results(1 To count)
        
        Set cell = rng.Columns(1).Find(What:=lookupValue, LookIn:=xlValues, LookAt:=xlWhole)
        
        Dim index As Long: index = 1
        Do
            results(index) = rng.Cells(cell.Row, 2).Value
            index = index + 1
            Set cell = rng.Columns(1).FindNext(cell)
        Loop While cell.Address <> firstCell.Address
        
        txtledglist.List = results
    End If
End Sub

我并不完全了解你的整个应用程序,但可能值得避免使用.Find.FindNext

相关问题