Excel VBA 用户表单使用复选框将数据输入多行

Question

您好，我需要根据选中的复选框一次输入多行数据。目前这只会增加 1 行。我想我必须使用一个循环，但我不确定我应该如何实现它。有人可以帮忙吗？

示例输出应如下所示：

TC37    | 1
TC37    | 2
TC37    | 4

当前代码：

Dim LastRow As Long, ws As Worksheet
Private Sub CommandButton1_Click()

  Set ws = Sheets("sheet1")

  LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1

  ws.Range("A" & LastRow).Value = ComboBox1.Text

  If CheckBox1.Value = True Then
    ws.Range("B" & LastRow).Value = "1"
  End If

  If CheckBox2.Value = True Then
    ws.Range("B" & LastRow).Value = "2"
  End If

  If CheckBox3.Value = True Then
    ws.Range("B" & LastRow).Value = "3"
  End If

  If CheckBox4.Value = True Then
    ws.Range("B" & LastRow).Value = "4"
  End If

End Sub

Private Sub UserForm_Initialize()
  ComboBox1.List = Array("TC37", "TC38", "TC39", "TC40")
End Sub

Answer 1

问题是您的变量 LastRow 没有改变。它只在开始时设置一次。所以当你尝试写入值时，它总是会写入同一个单元格。

If CheckBox1.Value = True Then
    LastRow = ws.Range("B100").end(xlup).Row + 1  
    ws.Range("B" & LastRow).Value = "1"
End If

If CheckBox2.Value = True Then
    LastRow = ws.Range("B100").end(xlup).Row + 1
    ws.Range("B" & LastRow).Value = "2"
End If

If CheckBox3.Value = True Then
    LastRow = ws.Range("B100").end(xlup).Row + 1
    ws.Range("B" & LastRow).Value = "3"
End If

If CheckBox4.Value = True Then
    LastRow = ws.Range("B100").end(xlup).Row + 1
    ws.Range("B" & LastRow).Value = "4"
End If

您也可以使用数组来存储值，然后将数组的结果粘贴到范围内。

有很多方法可以做到这一点，但这个应该行得通。您应该始终在粘贴值之前清理范围。

希望这对您有所帮助，

Answer 2

由于您有 1 次获取最后一行，因此您应该参考那一次转储数据。尝试类似的东西：

Dim chkCnt As Integer
Dim ctl As MSForms.Control, i As Integer, lr As Long
Dim cb As MSForms.CheckBox

With Me
    '/* check if something is checked */
    chkCnt = .CheckBox1.Value + .CheckBox2.Value + .CheckBox3.Value + .CheckBox4.Value
    chkCnt = Abs(chkCnt)
    '/* check if something is checked and selected */
    If chkCnt <> 0 And .ComboBox1 <> "" Then
        ReDim mval(1 To chkCnt, 1 To 2)
        i = 1
        '/* dump values to array */
        For Each ctl In .Controls
            If TypeOf ctl Is MSForms.CheckBox Then
                Set cb = ctl
                If cb Then
                    mval(i, 1) = .ComboBox1.Value
                    mval(i, 2) = cb.Caption
                    i = i + 1
                End If
            End If
        Next
    End If
End With
'/* dump array to sheet */
With Sheets("Sheet1") 'Sheet1
    lr = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & lr).Resize(UBound(mval, 1), 2) = mval
End With

Excel VBA 用户表单使用复选框将数据输入多行

Excel VBA Userform Entering Data into Multiple rows using checkboxes

checkbox

excel

vba

userform