Question

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

修改

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

像那样

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

用户窗体中.Search vba时自动检查复选框？

1 个答案:

修改