将VBA表单中的复选框添加到Excel电子表格中

Question

我想填充大小未知的范围，因为用户可以在第一组中选择最多15个项目。这将被插入到某一行。

我有下列名称/值的复选框：

Name   Value 
========== ===== 
chk_week1 1 
chk_week2 2 
...   ... 
...   ... 
chk_week15 15 

例如，如果用户选择chk_week1，chk_week2，chk_week4和chk_week5，那么它应该被插入到该细胞为1,2,4,5。

我已经包含图像如何看起来更好地展示它：

每个复选框在上表中列出的名称和值。以下是我目前使用的代码：

Private Sub btnSubmit_Click() 

Dim ws As Worksheet 
Dim rng1 As Range 
Set ws = Worksheets("main") 

' Copy the data to the database 
' Get last empty cell in column A 
Set rng1 = ws.Cells(Rows.Count, "a").End(xlUp) 

deptCodeSplit = Split(cbo_deptCode.Value, " ") 

' Having difficulty adding the code here 
' rng1.Offset(1, 6) = weeks 

End Sub 

Answer 1

链接的单元格中显示了标记复选框的值。两者都可以从复选框属性中分配。

让我们为每个单独的复选框指定1到15的值，Linkedcells位于单元格A1到A15中，勾选复选框的唯一值为1到15，或者对于未选中的复选框为空。在B列

通讯细胞将被用于顺序合并：

B1：

=IF(A1<>"",A1,"") 

B2到Bn：

=IF(AND(A2<>"",B1<>""),B1&" ,"&A2,IF(AND(B1="",A2<>""),A2,B1)) 

该公式可向下无限期被复制时，需要字符串将在最后一行。

来完成相同的VBA：

Function ValuesFromRange(Rng As range, Optional Delimiter As String) 

Dim c As range 
Dim txt As String 

If Delimiter = "" Then Delimiter = "," 
    txt = "" 

    For Each c In Rng 
    If Len(c.Value) > 0 Then 
     If Len(txt) = 0 Then 
      txt = c.Value 
     Else 
      txt = Trim(txt) & Delimiter & c.Value 
     End If 
    End If 
    Next 

ValuesFromRange = txt 

End Function 

电子表格例如： http://www.bumpclub.ee/~jyri_r/Excel/ValuesFromRange.xls