将选中的复选框标题导入表格

Question

我有一个用户表单，我想从中将值导入预定义的表（称为“Overzicht”）。

我有 12 个复选框（每个月一个），如果选中该复选框，我希望每个月都有一行。我想把复选框的标题放在表格的其中一列中。

例如，如果我检查 1 月、2 月和 3 月，我想将所有值导入到一个表中，分成三行，其中第一行“月份”列表示“一月”，第二行表示“二月”等。

我有代码检查选中复选框的数量并创建相同数量的行。我不知道如何在行中获得正确的标题。这是我目前所拥有的：

Private Sub CommandButton1_Click()

Dim rng As Range
Dim newrow As ListRow
Set rng = ThisWorkbook.Worksheets("Kostenoverzicht").Range("Overzicht")
Dim answer As Integer
'check number of rows to insert based on # of checked months
Dim ctl As MSForms.Control
Dim rows As Long
For Each ctl In Kostenoverzicht.Frame2.Controls
If TypeOf ctl Is MSForms.CheckBox Then
If Kostenoverzicht.Frame2.Controls(ctl.Name).Value = True Then
rows = rows + 1
End If
End If
Next

answer = MsgBox("Are you sure you want to continue?", vbQuestion + vbYesNo + vbDefaultButton1, "Zet in overzicht?")

If answer = vbYes Then
rng.Select
Set newrow = Selection.ListObject.ListRows.Add(alwaysinsert:=True)
With ws
For rows = 1 To rows
newrow.Range.Cells(rows, 1).Value = Me.TextBox1.Value
newrow.Range.Cells(rows, 2).Value = Me.CategorieBox.Value
newrow.Range.Cells(rows, 3).Value = Me.SubCategorieBox.Value
newrow.Range.Cells(rows, 4).Value = Me.BankrekeningBox.Value
If OptionButton1.Value = True Then newrow.Range.Cells(rows, 5).Value = "Af" Else newrow.Range.Cells(1, 5).Value = "Bij"
newrow.Range.Cells(rows, 6).Value = Me.TextBox2.Value
newrow.Range.Cells(rows, 7).Value = Me.CheckBox1.Caption
If OptionButton3.Value = True Then newrow.Range.Cells(rows, 8).Value = "Ja" Else newrow.Range.Cells(1, 8).Value = "Nee"
Next
End With

End If
End Sub

它将为所有行赋予值“January”。

我需要代码来替换 newrow.Range.Cells(rows, 7).Value = Me.CheckBox1.Caption 以获取选中复选框的标题。

我试图在几个网站上找到我的答案。

Answer 1

别介意我的第一个答案，我误解了，认为它总是会从一月到另一个月。但现在它似乎也可能只是 sept 和 nov 例如。在底部找到旧/错误的答案。 由于某种原因，您的代码对我来说非常难以理解。您检查要在顶部插入多少行，然后所有行似乎都得到了相同的信息，因为单元格 1-6 是来自其他非变量/动态源的值？我不确定我是否理解发生了什么。ws 是什么？它也有点调用用户表单，对吗？我不能真正重建你拥有的东西，因为我不太清楚。

最佳拍摄：

Private Sub CommandButton1_Click()

Dim rng As Range
Dim newrow As ListRow
Set rng = ThisWorkbook.Worksheets("Kostenoverzicht").Range("Overzicht")
Dim answer As Integer
Dim ctl As MSForms.Control
Dim rows As Long

answer = MsgBox("Are you sure you want to continue?", vbQuestion + vbYesNo + vbDefaultButton1, "Zet in overzicht?")
If Not answer = vbYes Then Exit Sub

For Each ctl In Kostenoverzicht.Frame2.Controls
    If TypeOf ctl Is MSForms.CheckBox Then
        If Kostenoverzicht.Frame2.Controls(ctl.Name).Value = True Then
            Set newrow = rng.ListObject.ListRows.Add(alwaysinsert:=True)

            newrow.Range.Cells(rows, 1).Value = Me.TextBox1.Value
            newrow.Range.Cells(rows, 2).Value = Me.CategorieBox.Value
            newrow.Range.Cells(rows, 3).Value = Me.SubCategorieBox.Value
            newrow.Range.Cells(rows, 4).Value = Me.BankrekeningBox.Value

            If OptionButton1.Value = True Then newrow.Range.Cells(rows, 5).Value = "Af" Else newrow.Range.Cells(1, 5).Value = "Bij"

            newrow.Range.Cells(rows, 6).Value = Me.TextBox2.Value
            newrow.Range.Cells(rows, 7).Value = ctl.Name 'Or maybe ctl.Caption ?

            If OptionButton3.Value = True Then newrow.Range.Cells(rows, 8).Value = "Ja" Else newrow.Range.Cells(1, 8).Value = "Nee"


        End If
    End If
Next

End Sub

我希望您能看到我在这里尝试做的事情，并且可以根据您的需要修复它/错误修复它。就像我说的，我没有重建一张表来测试它。无论如何，它可能对您有所帮助。

旧：

newrow.Range.Cells(rows, 7).Value = Format(3 + 31 * (rows - 1), "MMMM")

Answer 2

这段代码应该放在你的用户窗体后面

以下是您在编码时的一些建议：

1. 使用option explicit，这样您就不会出现未定义变量的意外行为
2. 始终缩进您的代码（请参阅 www.rubberduckvba.com 一个可以帮助您的免费工具）
3. 尝试将您的逻辑定义变量和重用它们分开

查看和自定义代码，使其符合您的需求。

您可以通过添加stop 并按F8 并逐行执行来查看代码中发生了什么。

代码：

Option Explicit

Private Sub CommandButton1_Click()

    ProcessForm

End Sub

Private Sub ProcessForm()

    Dim targetControl As MSForms.control

    Dim continue As Boolean

    continue = MsgBox("Are you sure you want to continue?", vbQuestion + vbYesNo + vbDefaultButton1, "Zet in overzicht?") = vbYes

    ' If it's not yes
    If Not continue Then Exit Sub

    For Each targetControl In Me.Controls

        If TypeOf targetControl Is MSForms.CheckBox Then
            Select Case targetControl.Value
            Case True
                ' Call the RecordData procedure (remember to add the controls in the parameters)
                RecordData targetControl.Caption, Me.TextBox1.Value, Me.TextBox2.Value
            Case False
                ' Do something?
            End Select
        End If

    Next targetControl
End Sub

Private Sub RecordData(ByVal recordMonth As String, ByVal textbox01Value As String, ByVal textbox02Value As String)

    Dim targetTable As ListObject
    Dim newRow As ListRow

    ' Refer to the table (no need for the worksheet reference)
    Set targetTable = Range("Overzicht").ListObject

    ' Add a new row an set a reference
    Set newRow = targetTable.ListRows.Add

    ' Refer to the columns by their header (replace with yours)
    newRow.Range.Cells(1, targetTable.ListColumns("Month").Index).Value = recordMonth
    newRow.Range.Cells(1, targetTable.ListColumns("Textbox1").Index).Value = textbox01Value
    newRow.Range.Cells(1, targetTable.ListColumns("Textbox2").Index).Value = textbox02Value

End Sub

让我知道它是否有效或您需要更多帮助