复制包含来自勾选框和下降数据的数据的单元格

Question

我有一个工作VBA的电子表格，可以在满足条件时将某些单元格复制到另一个工作表。

目前我有勾选框（在C栏中），它们链接到右边的单元格（D列），因此当单元格读取为TRUE时，代码会复制名称和与之关联的成本。我还有一个重置按钮，用于清空任何勾选的勾选框，因此将D列中的所有单元格（请参见附图）更改为FALSE。

问题在于此;我添加了一些额外的名称，要求用户说明与之关联的数字，因此这些实例中的勾选框已被替换为0到6的选项下拉，但重置按钮仍会导致下拉单元旁边的单元格读数为FALSE。

因此，我的问题是，如何修改代码（请参见下文）以复制名称和成本，其中复选框状态为TRUE（在D列中），下拉状态为0以外的数字（在列中） C）？

[Private Sub CommandButton1_Click()
Dim lastrow As Long, erow As Long
'to check the last filled row on sheet named one
lastrow = Worksheets("one").Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lastrow
If Worksheets("one").Cells(i, 4).Value = "TRUE" Then
    Worksheets("one").Cells(i, 2).Copy
    erow = Worksheets("two").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 1)
    Worksheets("one").Cells(i, 5).Copy
    Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 2)
End If
Next i
End Sub][1]

Answer 1

我在Stack Overflow上的第一个答案。我确信这是一种更有效的方法，但这似乎至少有效。

Private Sub CommandButton1_Click()
    Dim lastrow As Long, erow As Long
    'to check the last filled row on sheet named one
    lastrow = Worksheets("one").Cells(Rows.Count, 2).End(xlUp).Row
    For i = 2 To lastrow
    If Worksheets("one").Cells(i, 4).Value = True Then
        Worksheets("one").Cells(i, 2).Copy
        erow = Worksheets("two").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 1)
        Worksheets("one").Cells(i, 5).Copy
        Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 2)
    ElseIf Worksheets("one").Cells(i, 3).Value >= 1 And Worksheets("one").Cells(i, 3).Value <= 6 Then
        Worksheets("one").Cells(i, 2).Copy
        erow = Worksheets("two").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 1)
        Worksheets("one").Cells(i, 5).Copy
        Worksheets("one").Paste Destination:=Worksheets("two").Cells(erow + 1, 2)
    End If
    Next i
End Sub