使用 .Find 和 if 语句 vba 的列表框中的不同偏移量

Question

我在用户表单中有一个列表框，我在其中显示来自数据库的搜索。我希望能够在数据库中搜索信息的 14 列。所以我有一个用于搜索的文本框和一个用于在文本框更改时查看结果的列表框。这是我目前拥有的代码：

With ARK_database.Range("A:AS")
    Dim rng2Find As Range
    Dim strFirstFind As String

    lstLookup.Clear

    If Not kritLookup.Text = "" Then
        Set rng2Find = .Find(kritLookup.Text, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

        If Not rng2Find Is Nothing Then
            strFirstFind = rng2Find.Address

            Column = rng2Find.Column
            Do
                If Column = 1 Then
                    If rng2Find.Row > 1 Then
                        lstLookup.AddItem rng2Find.Value 'RefNr
                        lstLookup.List(lstLookup.ListCount - 1, 1) = rng2Find.Offset(0, 3) 'navn
                        lstLookup.List(lstLookup.ListCount - 1, 2) = rng2Find.Offset(0, 1) 'dato
                        lstLookup.List(lstLookup.ListCount - 1, 3) = rng2Find.Offset(0, 4) 'varsler navn
                        lstLookup.List(lstLookup.ListCount - 1, 4) = rng2Find.Offset(0, 6) 'varlser adr
                        lstLookup.List(lstLookup.ListCount - 1, 5) = rng2Find.Offset(0, 5) 'varsler tlf
                        lstLookup.List(lstLookup.ListCount - 1, 6) = rng2Find.Offset(0, 7) 'varsler zip
                        lstLookup.List(lstLookup.ListCount - 1, 7) = rng2Find.Offset(0, 8) 'varsler sted
                        lstLookup.List(lstLookup.ListCount - 1, 8) = rng2Find.Offset(0, 9) 'region
                     End If
                End If
                If Column = 43 Then
                     If rng2Find.Row > 1 Then
                        lstLookup.AddItem rng2Find.Value 'nettstasjon
                        lstLookup.List(lstLookup.ListCount - 1, 1) = rng2Find.Offset(0, -42) 'refnr
                        lstLookup.List(lstLookup.ListCount - 1, 2) = rng2Find.Offset(0, -41) 'dato
                        lstLookup.List(lstLookup.ListCount - 1, 3) = rng2Find.Offset(0, -39) 'reg av
                        lstLookup.List(lstLookup.ListCount - 1, 4) = rng2Find.Offset(0, -36) 'adr feil
                        lstLookup.List(lstLookup.ListCount - 1, 5) = rng2Find.Offset(0, -4) 'avg
                        lstLookup.List(lstLookup.ListCount - 1, 6) = rng2Find.Offset(0, -38) 'varsler
                        lstLookup.List(lstLookup.ListCount - 1, 7) = rng2Find.Offset(0, -21) 'kat
                        lstLookup.List(lstLookup.ListCount - 1, 8) = rng2Find.Offset(0, -33) 'region
                        lstLookup.List(lstLookup.ListCount - 1, 9) = rng2Find.Offset(0, -18) 'beskrivelse
                    End If
                End If

                Set rng2Find = .FindNext(rng2Find)
            Loop While Not rng2Find Is Nothing And rng2Find.Address <> strFirstFind
        End If
    Else
        lstLookup.Clear
    End If

 End With

我的问题是我不知道如何使用 .Find 对结果进行排序，我认为使用 For Each 会更容易，但速度要慢得多。我希望所有结果都显示在同一个列表框中，但偏移量正确。有更好的方法吗？或者有什么方法可以让它发挥作用？

谢谢

Answer 1

我知道怎么做了。这就是我最终得到的

Private Sub cmd_lookup_Click()
Application.ScreenUpdating = False
ARK_database.Activate
With ARK_database.Range("A:AS")
    Dim StartDate As Date
    Dim EndDate As Date
    Dim Tomorrow As Date
    Tomorrow = Date + 1

    Dim rng2Find As Range
    Dim strFirstFind As String
    Dim KritLookupFind As Range

    lstLookup.Clear

    If Not kritLookup.Text = "" Then
        Set rng2Find = .Find(kritLookup.Text, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

        'if value found then set a variable for the address
        If Not rng2Find Is Nothing Then
            strFirstFind = rng2Find.Address

            Column = rng2Find.Column

            If Column = 1 Or Column = 2 Or Column = 4 Or Column = 5 Or Column = 6 Or Column = 7 Or Column = 20 Or Column = 21 Or Column = 22 Or Column = 31 Or Column = 34 Or Column = 39 Or _
            Column = 43 Or Column = 45 Then
               Do
                    If rng2Find.Row > 1 Then
                        sjekkVariabel = Cells(rng2Find.Row, 1).Value
                        For i = 0 To lstLookup.ListCount - 1
                            If lstLookup.List(i) = sjekkVariabel Then
                                GoTo LastLine
                            End If
                        Next i
                        lstLookup.AddItem Cells(rng2Find.Row, 1).Value 'RefNr
                        lstLookup.List(lstLookup.ListCount - 1, 1) = Cells(rng2Find.Row, 1).Offset(0, 1) 'dato
                        lstLookup.List(lstLookup.ListCount - 1, 2) = Cells(rng2Find.Row, 1).Offset(0, 42) 'NS
                        lstLookup.List(lstLookup.ListCount - 1, 3) = Cells(rng2Find.Row, 1).Offset(0, 20) 'kommune
                        lstLookup.List(lstLookup.ListCount - 1, 4) = Cells(rng2Find.Row, 1).Offset(0, 21) 'komponent
                        lstLookup.List(lstLookup.ListCount - 1, 5) = Cells(rng2Find.Row, 1).Offset(0, 4) 'kunde navn
                        lstLookup.List(lstLookup.ListCount - 1, 6) = Cells(rng2Find.Row, 1).Offset(0, 24) 'beskrivelse
                    End If
                    'find the next address to add
LastLine:
                    Set rng2Find = .FindNext(rng2Find)
                Loop While Not rng2Find Is Nothing And rng2Find.Address  <> strFirstFind
            End If

                Set rng2Find = .FindNext(rng2Find)
        End If
        Else
            lstLookup.Clear
    End If
End With
End Sub

使用 .Find 和 if 语句 vba 的列表框中的不同偏移量

Different offsets in listbox using .Find and if statements vba

excel

vba

userform