如何在 vba 中使用“For each”循环？

Question

Sub Findnext()
Dim Name As String
Dim f As range
Dim ws As Worksheet
Dim s As Integer

Name = surname.Value
 'currently only searching one instance...doesn't loop and find the rest
Me.ListBox1.Clear
  Set f = Cells.Find(what:=Name, LookIn:=xlValues)
  Set findnext = f
 With ListBox1   
    Do
    Debug.Print findnext.Address
    Set findnext = Cells.findnext(findnext)
       .AddItem f.Value
       .List(0, 1) = f.Offset(0, 1).Value
       .List(0, 2) = f.Offset(0, 2).Value
       .List(0, 3) = f.Offset(0, 3).Value
       .List(0, 4) = f.Offset(0, 4).Value
       .List(0, 5) = f.Offset(0, 5).Value
       .List(0, 6) = f.Offset(0, 6).Value
  Loop While findnext.Address <> f.Address
  End With
End Sub

如何使这个代码循环，以便找到多个 f 值？本质上，我有一个搜索按钮，它提示“有 3 个实例”，在列表框中，它应该列出 3 个实例（例如，相同的名称）。

我尝试在上面的代码中使用 For each f 和 next f，但它仍然只选择一个 f.value 并且没有选择任何其他具有相同名称的单元格......

编辑： 我已经添加了循环功能，但现在在列表框中，它只列出了人的名字，而不是列出所有的偏移值。偏移量是否未应用于循环？还是因为它只在寻找 f？它要查找的名称是什么？

编辑：到目前为止我所做的编码......

Private Sub CommandButton1_Click()
MsgBox "Directorate has been added", vbOKOnly

 Dim ctrl As control
   For Each ctrl In UserForm1.Controls
     If TypeName(ctrl) = "CheckBox" Then
       'Pass this CheckBox to the subroutine below:
     TransferValues ctrl
     End If
   Next

TransferMasterValue 结束子

Sub TransferValues(cb As MSForms.CheckBox)
 Dim ws As Worksheet 
 Dim emptyRow As Long

If cb Then
   'Define the worksheet based on the CheckBox.Name property:
    Set ws = Sheets(Left(cb.Name, 15))
    emptyRow = WorksheetFunction.CountA(ws.range("A:A")) + 1
       With ws
           .Cells(emptyRow, 1).Value = surname.Value
           .Cells(emptyRow, 2).Value = firstname.Value
           .Cells(emptyRow, 3).Value = tod.Value
           .Cells(emptyRow, 4).Value = program.Value
           .Cells(emptyRow, 5).Value = email.Value
           .Cells(emptyRow, 6).Value = officenumber.Value
           .Cells(emptyRow, 7).Value = cellnumber.Value
        End With

  End If
End Sub

Sub TransferMasterValue()
 Dim allChecks As String
 Dim ws As Worksheet
   'Iterate through the checkboxes concatenating a string of all names
 For Each ctrl In UserForm1.Controls
   If TypeName(ctrl) = "CheckBox" Then
    If ctrl Then
        allChecks = allChecks & ctrl.Name & ""

    End If
   End If
 Next

'If you have at least one transfer to the Master sheet
  If Len(allChecks) > 0 Then
    Set ws1 = Sheets("Master")
    emptyRow = WorksheetFunction.CountA(range("A:A")) + 1

    With ws1
        .Cells(emptyRow, 1).Value = surname.Value
        .Cells(emptyRow, 2).Value = firstname.Value
        .Cells(emptyRow, 3).Value = tod.Value
        .Cells(emptyRow, 4).Value = program.Value
        .Cells(emptyRow, 5).Value = email.Value
        .Cells(emptyRow, 7).Value = officenumber.Value
        .Cells(emptyRow, 8).Value = cellnumber.Value
        .Cells(emptyRow, 6).Value = Left(allChecks, Len(allChecks) - 1)
    End With
  End If
End Sub

Private Sub CommandButton2_Click()
 Unload UserForm1
End Sub

Private Sub CommandButton3_Click()
 surname.Value = ""
 firstname.Value = ""
 tod.Value = ""
 program.Value = ""
 email.Value = ""
 officenumber.Value = ""
 cellnumber.Value = ""
 PACT.Value = False
 PrinceRupert.Value = False
 WPM.Value = False
 Montreal.Value = False
 TET.Value = False
 TC.Value = False
 US.Value = False
 Other.Value = False
End Sub

Private Sub ListBox1_Click()
 Dim r As Long
 With Me.ListBox1

  With Me
    .surname.Value = .ListBox1.List(.ListBox1.ListIndex, 0)
    .firstname.Value = .ListBox1.List(.ListBox1.ListIndex, 1)
    .tod.Value = .ListBox1.List(.ListBox1.ListIndex, 2)
    .program.Value = .ListBox1.List(.ListBox1.ListIndex, 3)
    .email.Value = .ListBox1.List(.ListBox1.ListIndex, 4)
    .officenumber.Value = .ListBox1.List(.ListBox1.ListIndex, 5)
    .cellnumber.Value = .ListBox1.List(.ListBox1.ListIndex, 6)
  End With
 End With
End Sub

Private Sub Search_Click() 'only searches in master tab right now need to search from all worksheets
 Dim Name As String
 Dim f As range
 Dim r As Long
 Dim ws As Worksheet
 Dim s As Integer
 Dim FirstAddress As String

   Name = surname.Value

     With ws
        Set f = range("A:A").Find(what:=Name, LookIn:=xlValues)
       If Not f Is Nothing Then
     With Me
        firstname.Value = f.Offset(0, 1).Value
        tod.Value = f.Offset(0, 2).Value
        program.Value = f.Offset(0, 3).Value
        email.Value = f.Offset(0, 4).Text
        officenumber.Value = f.Offset(0, 5).Text
        cellnumber.Value = f.Offset(0, 6).Text
     End With
   findnext
        FirstAddress = f.Address
Do
    s = s + 1
    Set f = range("A:A").findnext(f)
            Loop While Not f Is Nothing And f.Address <> FirstAddress
    If s > 1 Then
       Select Case MsgBox("There are " & s & " instances of " & Name, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")

       Case vbOK
            findnext
        Case vbCancel
       End Select

    End If

Else: MsgBox Name & "Not Listed"
End If
End With

End Sub

Sub findnext()
 Dim Name As String
 Dim f As range
 Dim ws As Worksheet
 Dim s As Integer
 Dim findnext As range

   Name = surname.Value
   Me.ListBox1.Clear
     Set f = range("A:A").Find(what:=Name, LookIn:=xlValues)
     Set findnext = f

      With ListBox1
     Do
      Debug.Print findnext.Address
      Set findnext = range("A:A").findnext(findnext)
       .AddItem findnext.Value
       .List(0, 1) = findnext.Offset(0, 1).Value
       .List(0, 2) = findnext.Offset(0, 2).Value
       .List(0, 3) = findnext.Offset(0, 3).Value
       .List(0, 4) = findnext.Offset(0, 4).Value
       .List(0, 5) = findnext.Offset(0, 5).Value
       .List(0, 6) = findnext.Offset(0, 6).Value
       .List(0, 7) = findnext.Offset(0, 6).Value
   Loop While findnext.Address <> f.Address
       End With

End Sub

Answer 1

你需要Find 然后FindNext 循环。当您的 FindNext 找到您再次找到的第一个东西时，您就知道您已经完成了循环。它会这样循环。

Dim firstFind As Range, subsequentFinds As Range

Set firstFind = Range("D3:D500").Find("search string", , xlValues)

Set subsequentFinds = firstFind
Do
    Debug.Print subsequentFinds.Address
    Set subsequentFinds = Cells.FindNext(subsequentFinds)
Loop While subsequentFinds.Address <> firstFind.Address