在用户表单中搜索 vba 时自动检查复选框？

Question

所以我在下面有以下代码：我要关注的是 Private Sub Search_Click()。目前，当我搜索某人的姓氏时，它会自动填充文本框。是否可以有一个自动填充复选框的搜索框？例如，如果该人属于 6/8 复选框，并且我单击搜索 6/8 复选框会被选中吗？是否可以用 ListBox1_Click() 做同样的事情？因此，当我从列表框中单击人名时，它还会根据该人所属的复选框自动填充复选框？

编辑

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

For Each ws In ActiveWorkbook.Sheets
With ws
  Set f = Range("A:A").Find(what:=Name, LookIn:=xlValues)
 If Not f Is Nothing Then
    If cb.Name = ws.Name Then
        cb.Value = True
    End If
Next
 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

这就是它的样子……？我不能让它工作吗？

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
End Sub

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

这似乎不是编码问题，我看到了您设置文本框文本的代码。基本上，您将设置复选框，而不是设置文本框文本。代码是ChkCheck.value = true.

如果有更深层次的问题并进行编辑，请发表评论

编辑

要搜索所有工作表，

我会在里面放一个循环

for each ws in ActiveWorkbook.Sheets

然后把你的搜索放在那里。

然后，在if f is not nothing then之后

遍历所有控件，并检查控件名称是否=工作表名称。 -

if ctrl.name = ws.name then
    ctrl.value = true
end if

这样

因此，每次工作表循环运行时，如果找到特定名称，则与特定工作表相关的复选框将检查。