如何在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值？ essentailly，我有一個搜索按鈕，它提示“有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