如何拆分单元格中的多个值并链接到用户表单中的复选框

Question

您好，我有以下按姓氏搜索并在文本框中返回值的代码。我希望根据第 6 列 (f.offset(0,5)) 勾选复选框。但是当我使用下面的代码时，它不会在第 6 列的单元格中提取多个值。它只能提取第一个值。我该如何解决这个问题？

Private Sub Search_Click()
Dim Name As String
Dim f As Range
Dim r As Long
Dim ws As Worksheet
Dim s As Integer
Dim FirstAddress As String
Dim str() 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, 6).Text
    cellnumber.Value = f.Offset(0, 7).Text

str() = Split(f.Offset(0, 5), " ")

For i = 0 To UBound(str)

Select Case UCase(Trim(str(i)))
 Case "PACT": PACT.Value = True
 Case "PrinceRupert": PrinceRupert.Value = True
 Case "Montreal": Montreal.Value = True
 Case "TET": TET.Value = True
 Case "WPM": WPM.Value = True
 Case "TC": TC.Value = True
 Case "US": US.Value = True
 Case "Other": Other.Value = True

End Select

编辑：我已使用此代码将名称添加到第 6 列

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 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 & " " 'the names of the checkboxes separated by a spcae in between them
        Debug.Print allchecks

    End If
 End If
Next

'If you have at least one transfer to the Master sheet
If Len(allchecks) > 0 Then
'Your code to transfer
 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) 'to add to column 6

编辑 2：

这是我在上面运行 debug.print allcheck 以将名称添加到第 6 列时的显示方式

PACT PrinceRupert 
PACT PrinceRupert Montreal 
PACT PrinceRupert Montreal WPM 
PACT PrinceRupert Montreal WPM TC 
PACT PrinceRupert Montreal WPM TC TET 
PACT PrinceRupert Montreal WPM TC TET US 
PACT PrinceRupert Montreal WPM TC TET US Other 

编辑 3：https://www.dropbox.com/s/36e9fmbf17wpa0l/example.xlsm

Answer 1

您正在对大写值运行您的选择，但各个 Case 项目是大小写混合的。 “PRINCERUPERT”与“PrinceRupert”不匹配

要么不要将 Select 项大写，要么将所有 Case 项更改为大写。

编辑 - 如果仍然无法正常工作，那么您需要检查您的 Select 中输入的内容。添加如下所示的行并查看它产生的结果（将显示在“立即”窗格中）

For i = 0 To UBound(str)
Debug.Print Trim(str(i))  '<< add this
Select Case UCase(Trim(str(i)))