繁体   English   中英

如果有多个,有什么方法可以让这个 VBA 代码找到下一个相同的值?

[英]Is any way to make this VBA code to find next same value if there are more than one?

我是 vba 的初学者,搜索和阅读有关 vba 的不同内容我已经创建了一段代码,但没有按我的意愿工作。 如果我搜索一个特定的值,代码会找到它并在特定的文本框上显示一个特定的值,但是如果有多个相同的值(在搜索列中)我想将代码 go 设置为下一个,直到找到每个相同的值,我的实际代码没有做什么。 我很感激改进此代码或任何其他代码的任何帮助。

这是我的代码,

Private Sub Search_Click()

Dim a As String
Dim b As Double
Dim k As Range

On Error GoTo dontexist:

If Me.TextBox20.Value = "" Or Me.TextBox20.Value = "Number of invoice" Then

    Me.Label29.Caption = "Number of invoice"

    b = Me.TextBox24.Value

    Set k = Sheets("Sheet2").Range("E:E")

    r = Application.WorksheetFunction.Match(b, k, 0)

    Me.TextBox21.Value = Sheets("Sheet2").Cells(r, 2).Value
    Me.TextBox22.Value = Sheets("Sheet2").Cells(r, 8).Value
    Me.TextBox23.Value = Sheets("Sheet2").Cells(r, 4).Value
    Exit Sub

Else

    Me.Label29.Caption = "Sum of invoice"

    a = Me.TextBox20.Value

    Set k = Sheets("Sheet2").Range("H:H")

    r = Application.WorksheetFunction.Match(a, k, 0)

    Me.TextBox21.Value = Sheets("Sheet2").Cells(r, 2).Value
    Me.TextBox22.Value = Sheets("Sheet2").Cells(r, 5).Value
    Me.TextBox23.Value = Sheets("Sheet2").Cells(r, 4).Value
Exit Sub

End If

dontexist:

    MsgBox "This record dosn't exist!", vbInformation, "Info!"

End Sub

将 label 添加到您的表单以保存最后找到的行并从那里开始搜索。 我用过label30。

Option Explicit

Private Sub Search_Click()

    Dim rngSearch As Range, rngFound As Range, sColumn As String
    Dim sValue As String, iCount As Long
    Dim ws As Worksheet
    Set ws = Sheets("Sheet2")
    
    ' label to hold row to start search at
    If Label30 = "" Then Label30 = "1"

    If Len(TextBox24) > 0 Then
        ' search on number
        sValue = TextBox24
        sColumn = "E"
        Label29 = "Number of invoice"
             
    ElseIf Len(TextBox20) > 0 Then
        ' search on total
        sValue = TextBox20
        sColumn = "H"
        Label29 = "Sum of invoice"
        
    Else
        MsgBox "No search values entered", vbExclamation
        Exit Sub
    End If
    
    ' count number of matches
    Set rngSearch = ws.Cells(1, sColumn).EntireColumn
    iCount = Application.WorksheetFunction.CountIf(rngSearch, sValue)
    
    If iCount > 0 Then
    
      ' continue search from last position
      Set rngFound = rngSearch.Find(sValue, _
      After:= ws.Range(sColumn & Label30), _
      LookIn:=xlValues, _
      LookAt:=xlWhole)
      
      If rngFound Is Nothing Then
         ' not found
         Label30 = ""
         MsgBox "No more records found"
      Else
         ' is row new
         If rngFound.Row > Label30 Then
             'MsgBox rngFound.Row
             
             ' copy into text boxes
             With rngFound.EntireRow
                 If sColumn = "E" Then
                     TextBox21 = .Cells(1, 2)
                     TextBox22 = .Cells(1, 8)
                     TextBox23 = .Cells(1, 4)
                 Else
                     TextBox21 = .Cells(1, 2)
                     TextBox22 = .Cells(1, 5)
                     TextBox23 = .Cells(1, 4)
                 End If
             End With
             Label30 = rngFound.Row
             
         Else
             MsgBox "No more records found", vbExclamation
             Label30 = ""
             Exit Sub
         End If
         
      End If
    
    Else
    
       MsgBox "No records found", vbExclamation
       Label30 = ""
    
    End If
     
End Sub

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM