如何将多个值添加到一个单个单元格中

时间:2014-01-29 16:04:10

标签: excel vba excel-vba userform

Private Sub CommandButton1_Click()
 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
End Sub

Sub TransferValues(cb As MSForms.CheckBox)
 Dim ws As Worksheet
 Dim emptyRow As Long
 Dim ws1 As Worksheet

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
    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, 6).Value = officenumber.Value
            .Cells(emptyRow, 7).Value = cellnumber.Value
            .Cells(emptyRow, 8).Value = cb.Name
        End With
  End If
'the master sheet needs to have a "Stakeholder" column with list of stakeholder the person belongs to

这里的问题是Cb.Name - 我希望名称复选框出现在一个单元格中,但现在它根据复选框的数量创建额外的行。因此,不是将6/8个复选框的名称放入1个单个单元格中,而是将6个行放入每个名称并不是很好。如何将所有cb.names转移到一个单元格中?

抱歉,如果代码看起来格式不正确 - 由于某种原因它没有显示所有缩进...

2 个答案:

答案 0 :(得分:1)

如果我读了你的权利,你的转让功能会处理个别支票,但是主表需要为整批提供一条线,对吗?

如果是这样,您需要做的是分别处理个人和集体层面。从基本子目录中删除对主表单的所有引用,并自行处理主表单

Sub TransferMasterValue()
Dim allChecks As String

'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
    'Your code to transfer
    Set ws1 = Sheets("Master")
    emptyRow = WorksheetFunction.CountA(range("A:A")) + 1

    With ws1
        .Cells(emptyRow, 1).Value = surname.Value
        ...
        'and post the concatenated value in the name position
        .Cells(emptyRow, 8).Value = left(allChecks,len(allChecks)-1)
    End With
End If
End Sub

主按钮点击功能将显示为......

Private Sub CommandButton1_Click()
 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

答案 1 :(得分:0)

你试过连接吗?如果我有单元格| 1 | 2 | 3 | 4 | 5 |我可以插入函数= CONCATENATE(A1,“,”,B1),你可以改为“,”到“”为空格,或根本没有分离。如果这不是您想要的,那么我认为我错误地解决了这个问题。