如何在单元格中分割多个值并链接到用户窗体中的checkbox

您好,我有以下代码search的姓氏和返回文本框中的值。 我希望checkbox取决于第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

您正在运行您的select上大写的值,但个别案例项目是混合大小写。 “PRINCERUPERT”不符合“PrinceRupert”

或者不要大写Select项,或者将所有的Case条件更改为上限。

编辑 – 如果它仍然不工作,那么你需要检查什么是喂你的Select 。 添加下面显示的行,看看它产生了什么(将显示在即时窗格)

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