复制和粘贴具有异常的Excel单元格-VBA

时间:2018-07-12 20:31:58

标签: excel vba excel-vba exception copy-paste

我有一个带有复选框的excel文件,当选中复选框时,当链接的单元格为TRUE时,VBA代码将复制该行中的所需单元格。请参见下面的示例。

[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]

但是我想知道是否可以添加例外吗?因此,如果链接的单元格的状态为TRUE,而同一行中的另一个单元格的状态为从不,则不要复制并粘贴该行,而是仍粘贴TRUE所在的所有其他实例。

1 个答案:

答案 0 :(得分:0)

类似以下内容:

Option Explicit
Private Sub CommandButton1_Click()
    Dim lastrow As Long, erow As Long, i As Long
    Application.ScreenUpdating = False
    With Worksheets("one")
        lastrow = .Cells(Rows.Count, 2).End(xlUp).Row
        For i = 2 To lastrow
            If .Cells(i, 4).Value And .Rows(i).Find("NEVER", LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
                 erow = Worksheets("two").Cells(Rows.Count, 1).End(xlUp).Row
                 Worksheets("two").Cells(erow + 1, 1) = .Cells(i, 2)
                 Worksheets("two").Cells(erow + 1, 2) = .Cells(i, 5)
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub