Fatal编程技术网
  • excel/
  • Excel 使用.Find和if语句vba在列表框中使用不同的偏移量

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

excel vba

Excel 使用.Find和if语句vba在列表框中使用不同的偏移量,excel,vba,userform,Excel,Vba,Userform,我在userform中有一个列表框，其中显示了数据库中的搜索。我在数据库中有14列，我希望能够搜索信息。因此，我有一个用于搜索的文本框和一个列表框，用于在文本框更改时查看结果。以下是我目前拥有的代码： With ARK_database.Range("A:AS") Dim rng2Find As Range Dim strFirstFind As String lstLookup.Clear If Not kritLookup.Text = "" Then

我在userform中有一个列表框，其中显示了数据库中的搜索。我在数据库中有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

带有ARK_数据库.Range（“A:AS”）
Dim RNG2查找As范围
Dim strFirstFind As字符串
好的，明白了
如果不是kritLookup.Text=“”，则
设置rng2Find=.Find（kritLookup.Text，LookIn:=xlValues，LookAt:=xlPart，MatchCase:=False）
如果不是rng2Find，则为Nothing
strFirstFind=rng2Find.Address
Column=rng2查找列
做
如果列=1，则
如果RNG2查找行>1，则
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
lstLookup.List（lstLookup.ListCount-1,8）=rng2Find.Offset（0,9）”区域
如果结束
如果结束
如果列=43，则
如果RNG2查找行>1，则
lstLookup.AddItem rng2Find.Value“nettstatsjon”
lstLookup.List（lstLookup.ListCount-1,1）=rng2Find.Offset（0，-42）”参考编号
lstLookup.List（lstLookup.ListCount-1,2）=rng2Find.Offset（0，-41）'dato
lstLookup.List（lstLookup.ListCount-1,3）=rng2查找偏移量（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）“平均值
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）”区域
lstLookup.List（lstLookup.ListCount-1,9）=rng2Find.Offset（0，-18）'beskrivelse
如果结束
如果结束
设置rng2Find=.FindNext（rng2Find）
非rng2Find时的循环为Nothing，rng2Find.Address strFirstFind为Nothing
如果结束
其他的
好的，明白了
如果结束
以
我的问题是，我不知道如何使用.Find对结果进行排序。我假设使用a 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

Private Sub cmd\u lookup\u Click（）
Application.ScreenUpdating=False
ARK_database.Activate
使用ARK_database.Range（“A:AS”）
Dim StartDate作为日期
Dim EndDate作为日期
黯淡的明天
明天=日期+1
Dim RNG2查找As范围
Dim strFirstFind As字符串
Dim KritLookupFind As范围
好的，明白了
如果不是kritLookup.Text=“”，则
设置rng2Find=.Find（kritLookup.Text，LookIn:=xlValues，LookAt:=xlPart，MatchCase:=False）
'如果找到值，则为地址设置一个变量
如果不是rng2Find，则为Nothing
strFirstFind=rng2Find.Address
Column=rng2查找列
如果Column=1或Column=2或Column=4或Column=5或Column=6或Column=7或Column=20或Column=21或Column=22或Column=31或Column=34或Column=39或_
列=43或列=45，则
做
如果RNG2查找行>1，则
Sjekvariabel=单元格（rng2Find.Row，1）.Value
对于i=0到lstLookup.ListCount-1
如果lstLookup.List（i）=sjekvariabel，则
转到最后一行
如果结束
接下来我
lstLookup.AddItem单元格（rng2Find.Row，1）。值'RefNr
lstLookup.List（lstLookup.ListCount-1,1）=单元格（rng2Find.Row，1）.Offset（0,1）'dato
lstLookup.List（lstLookup.ListCount-1,2）=单元格（rng2Find.Row，1）.Offset（0,42）'NS
lstLookup.List（lstLookup.ListCount-1,3）=单元格（rng2Find.Row，1）.Offset（0,20）'kommune
lstLookup.List（lstLookup.ListCount-1,4）=单元格（rng2Find.Row，1）.Offset（0,21）'komponent
lstLookup.List（lstLookup.ListCount-1,5）=单元格（rng2Find.Row，1）.Offset（0,4）'kunde navn
lstLookup.List（lstLookup.ListCount-1,6）=单元格（rng2Find.Row，1）.Offset（0,24）'beskrivelse
如果结束
'查找要添加的下一个地址
最后一行：
设置rng2Find=.FindNext（rng2Find）
非rng2Find时的循环为Nothing，rng2Find.Address strFirstFind为Nothing
如果结束
设置rng2Find=.FindNext（rng2Find）
如果结束
其他的
好的，明白了
如果结束
以
端接头
我知道怎么做了。这就是我的结局

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

Private Sub cmd\u lookup\u Click（）
Application.ScreenUpdating=False
阿库数据库。