[英]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.