将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

标记复选框的值显示在Linkedcell中。两者都可以从Checkbox Properties中分配。

让我们为每个单独的复选框分配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