Question

A      B      C        D

1     ...     1        2

2     ...    1.2       

3     ...    1.9

4     ...    1.1       4

5     ...     1        3

6     ...     1

7     ...     1        5

8     ...     3

我需要的功能应该搜索col D并查找没有条目的所有行，然后将相应的值从col A和col B复制到另一个工作表。

例如，在此虚拟代码中，A2，A3，A6，A8和B2，B3，B6，B8必须复制到新的工作表。

我尝试使用vlookup和index命令，但它只获取第一个条目的值并将其拖放不起作用。

Answer 1

这可以做你想要的，只需更改工作表编号以反映你正在使用的工作表（我使用Sheet1作为带有数据的工作表和Sheet3到应放置摘要数据的工作表）这些工作表名称是它们的编码excel上底部选项卡上的版本而不是他们的名字：

Sub foo()
LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row 'change Sheet1 to your sheet ie. Sheets("Sheet1")
For i = 2 To LastRow
    If Sheet1.Cells(i, 4).Value = "" Then
        NextEmptyRow = Sheet3.Cells(Sheet3.Rows.Count, "A").End(xlUp).Row + 1
        Sheet3.Cells(NextEmptyRow, 1).Value = Sheet1.Cells(i, 1).Value
        Sheet3.Cells(NextEmptyRow, 2).Value = Sheet1.Cells(i, 2).Value
    End If
Next i
End Sub

<强>更新

如果您在Excel的底部标签中引用了表格，那么您应该更改上面的代码：

Sub foo()
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1") 'change the name of your sheets here
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet3")
LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 
For i = 2 To LastRow
    If ws1.Cells(i, 4).Value = "" Then
        NextEmptyRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
        ws2.Cells(NextEmptyRow, 1).Value = ws1.Cells(i, 1).Value
        ws2.Cells(NextEmptyRow, 2).Value = ws1.Cells(i, 2).Value
    End If
Next i
End Sub

Answer 2

如果您使用过滤器设置数据，则在D列上使用过滤器。

Sub CopyData()

    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet

   Set wb = ThisWorkbook
   Set wsSource = wb.Worksheets("Source") ' change as appropriate
   Set wsTarget = wb.Worksheets("Target") ' change as appropriate

        With wsSource
            .ListObjects("Table1").AutoFilter.ShowAllData
            .ListObjects("Table1").Range.AutoFilter Field:=4, Criteria1:="="
            .AutoFilter.Range.Columns("A:B").Copy wsTarget.Range("A1")
       End With
End Sub

Excel复制所选列的相邻值，单元格中没有条目

2 个答案: