.Findとif文を使用してリストボックス内の異なるオフセット。

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を使用して結果をソートする方法を見つけ出すが、多く遅くなることができないということです。すべての結果を同じリストボックスに表示したいが、オフセットは正しい。これを行うより良い方法はありますか？またはそれを動作させるための何らかの方法ですか？

ありがとうございました

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