Question

我需要将数据从一个工作表复制到另一个工作表。但是，我需要一个条件复制操作，它将根据条件跳过行。

例如，如果我开始......

Active  Value
yes     1
no      2
no      3
yes     4
no      5
no      6

我只想复制Active = yes的行，所以我最终会得到......

Value
1
4

有人可以告诉我如何使用1）宏和2）公式吗？

Answer 1

公式方法：

假设您的数据位于sheet1，范围A2:B7。

然后在sheet2单元A2中使用此公式：

=IFERROR(INDEX(Sheet1!B:B,SMALL(IF(Sheet1!$A$2:$A$7="yes",ROW(Sheet1!$A$2:$A$7)),ROW()-ROW($A$2)+1)),"")

使用数组输入（ CTRL + SHIFT + ENTER ），然后将其向下拖动。

enter image description here

VBA方法：

您可以使用AutoFilter：

Sub test()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng As Range, rngToCopy As Range
    Dim lastrow As Long
    'change Sheet1 and Sheet2 to suit
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")

    With ws1
        'assumung that your data stored in column A:B, Sheet1
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rng = .Range("A1:B" & lastrow)
        'clear all filters
        .AutoFilterMode = False
        With rng
            'apply filter
            .AutoFilter Field:=1, Criteria1:="yes"
            On Error Resume Next
            'get only visible rows
            Set rngToCopy = .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
        'copy range
        If Not rngToCopy Is Nothing Then rngToCopy.Copy Destination:=ws2.Range("A1")
        'clear all filters
        .AutoFilterMode = False
    End With
    Application.CutCopyMode = False
End Sub

enter image description here

注意，如果您只想复制Value列，请更改

Set rngToCopy = .SpecialCells(xlCellTypeVisible)

到

Set rngToCopy = .Offset(, 1).Resize(, .Columns.Count - 1).SpecialCells(xlCellTypeVisible)

Answer 2

使用宏很容易。假设您要从第一张表格复制到第二张表格，并且上面的示例位于A列和B列，您可以执行以下操作：

Public Sub ConditionalCopy()

    Dim copyRng As Range
    Set copyRng = Worksheets(1).Range("B2:B7")

    Dim pasteRng As Range
    Set pasteRng = Worksheets(2).Range("A2")

    Dim i As Long
    i = 0

    For Each cell in copyRng.Cells
       If cell.Offset(0, -1).Value2 = "yes" Then
          pasteRng.Offset(i,0).Value2 = cell.Value2
          i = i + 1
       End If
    Next cell
End Sub

使用公式进行操作对于不在第二张纸上留下任何空白行而言是一个挑战。在第二张表中使用以下内容非常简单：

=If(A2 = "yes",b2,"")

然后将其复制下来，但是你最终会得到一些空白行，你必须自己回去删除。如果你有能力使用宏，它就足够直接了，我会走这条路，而不是在制定一个公式时投入太多精力。我越是想到它，我越觉得它必须是一个避免双重引用的程序化解决方案。

Answer 3

如果对源行和目标行使用单独的计数器，并使用单元格引用而不是范围，则以下例程应该起作用

Public Sub copyactivevalue()

Dim i As Integer
Dim j As Integer
Dim acts As Excel.Worksheet
Dim news As Excel.Worksheet

Set acts = Excel.Worksheets("sheet1")
Set news = Excel.Worksheets("sheet2")


With acts
    j = 2
    For i = 2 To 7
        If acts.Cells(i, 1).Value = "yes" Then
            news.Cells(j, 1) = acts.Cells(i, 2).Value
            j = j + 1
        End If

    Next
End With

Set acts = Nothing
Set news = Nothing
End Sub

希望这有帮助

Excel表达式复制行但删除空行

3 个答案: