列表框中使用.Find和if语句的不同偏移量vba
我有一个用户表单中的数据库显示search的列表框。 我在数据库中有14列,我希望能够search信息。 所以我有一个文本框用于search和一个列表框来查看文本框更改结果。 这是我现在的代码:
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
我的问题是,我不知道如何使用查找sorting结果。我认为使用一个For Each会更容易,但更慢。 我想要所有的结果显示在同一个列表框中,但偏移量正确。 有没有更好的方法来做到这一点? 或者让它工作的一些方法?
谢谢
我想出了如何做到这一点。 这是我结束了
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