如果值匹配,则处理整行

时间:2017-10-09 09:20:08

标签: excel vba excel-vba

我正在尝试构建一个宏,如果来自列S的值(REPORT ID)与sheet2中列A的REPORT ID匹配,则会将当前行复制到新工作表。我假设可以使用自定义过滤器/ VBA宏来完成。你能指点我正确的方向吗?感谢帮助。

此致 达米安

1 个答案:

答案 0 :(得分:0)

我假设您的所有三张工作簿都在同一工作簿中,而且这一工作簿是当前工作簿。

如果您希望Sheet1中的S列值与Sheet2中同一行的A列匹配

Sub CopyEntireRowIfMatch()
    Dim wb As Workbook
    Dim ws1 As Worksheet        'your first worksheet
    Dim ws2 As Worksheet        'your second worksheet
    Dim dstWs As Worksheet      'your destination sheet
    Dim colNameSheet1 As String 'your column name in sheet 1
    Dim colNameSheet2 As String 'your column name in sheet 2
    Dim count As Double
    Dim colNumSheet1 As Integer

    Set wb = ActiveWorkbook
    Set ws1 = wb.Sheets("Name of your first sheet")
    Set ws2 = wb.Sheets("Name of your second sheet")
    Set dstWs = wb.Sheets("Name of your destination sheet")
    colNameSheet1 = "S"
    colNameSheet2 = "A"

    count = 1
    colNumSheet1 = Range(colNameSheet1 & "1").Column

    For Each cell In ws1.Range(colNameSheet1 & "1:" & colNameSheet1 & WorksheetFunction.CountA(ws1.Columns(colNumSheet1)))
        If (cell = ws2.Range(colNameSheet2 & cell.Row)) Then
            ws1.Rows(cell.Row).EntireRow.Copy
            dstWs.Range("A" & count).PasteSpecial
            count = count + 1
        End If
    Next cell

    Set ws1 = Nothing
    Set ws2 = Nothing
    Set dstWs = Nothing

End Sub

如果您希望Sheet1中的列S中的值与Sheet2的A列中的任何行匹配

Sub CopyEntireRowIfMatch()
    Dim wb As Workbook
    Dim ws1 As Worksheet        'your first worksheet
    Dim ws2 As Worksheet        'your second worksheet
    Dim dstWs As Worksheet      'your destination sheet
    Dim colNameSheet1 As String 'your column name in first sheet
    Dim colNameSheet2 As String 'your column name in second sheet
    Dim count As Double
    Dim colNumSheet1 As Integer
    Dim colNumSheet2 As Integer

    Set wb = ActiveWorkbook
    Set ws1 = wb.Sheets("Name of your first sheet")
    Set ws2 = wb.Sheets("Name of your second sheet")
    Set dstWs = wb.Sheets("Name of your destination sheet")
    colNameSheet1 = "S"
    colNameSheet2 = "A"

    count = 1
    colNumSheet1 = Range(colNameSheet1 & "1").Column
    colNumSheet2 = Range(colNameSheet2 & "1").Column

    For Each cell In ws1.Range(colNameSheet1 & "1:" & colNameSheet1 & WorksheetFunction.CountA(ws1.Columns(colNumSheet1)))
        For Each cellInSecondSheet In ws2.Range(colNameSheet2 & "1:" & colNameSheet2 & WorksheetFunction.CountA(ws2.Columns(colNumSheet2)))
            If (cell = cellInSecondSheet) Then
                ws1.Rows(cell.Row).EntireRow.Copy
                dstWs.Range(colNameSheet2 & count).PasteSpecial
                count = count + 1
            End If
        Next cellInSecondSheet
    Next cell

    Set ws1 = Nothing
    Set ws2 = Nothing
    Set dstWs = Nothing

End Sub

用法

将[{1}}中的第一张名称替换为工作簿中的工作表名称。

Set ws1 = wb.Sheets("Name of your first sheet")中的第二张的名称替换为要比较值的工作表名称(示例中的工作表2)。

Set ws2 = wb.Sheets("Name of your second sheet")中将目标表的名称替换为要在整个行匹配后粘贴整个行的表单的名称。

Set dstWs = wb.Sheets("Name of your destination sheet")中的 S 替换为第一张表中列的名称。

colNameSheet1 = "S"中的 A 替换为第二张表中列的名称。