如何匹配两个动态表中的信息

时间:2018-12-19 17:19:41

标签: excel-vba

我有两个报告。一种是已从库存中删除的项目编号。另一个是从库存中收到项目的项目。这两个报告的总美元金额始终相同。具有匹配信息的唯一列是标题为“ Capital-Data”的工作表中的A列和标题为“ O&M-Data”的工作表中的J列。请注意,实际的工作表包含数千行,并且是动态的。此外,工作表的行数也不相同。

在“资本数据”工作表上,任何以“ ITS”开头的项目编号都必须从表格中删除,并在表格下方列出。

在“ O&M-数据”表上,必须从“ O&M-数据”表中删除J列中与第一个工作表中的表下方列出的项目的A列匹配的任何项目,并将其粘贴在该表的下方。

这是我复制/编写的代码:

Sub Candace()
'
' Candace Macro

Dim i As Long
Dim r As Long
Dim UsdRws As Long
Dim UsdRws2 As Long
Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
Dim currentRowValue As String
Sheets("Capital-Data").Select
Dim lastrow As Long
lastrowsheet1 = Worksheets("Capital-Data").Cells(Rows.Count, 1).End(xlUp).Row
lastrowsheet2 = Worksheets("O&M-Data").Cells(Rows.Count, 1).End(xlUp).Row

    Selection.CurrentRegion.Select
    ActiveWorkbook.Worksheets("Capital-Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Capital-Data").Sort.SortFields.Add Key:=Range("E:E") _
        , sorton:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Capital-Data").Sort
        .SetRange Range("a1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = False

    UsdRws = Range("A1").CurrentRegion.Rows.Count

    For i = UsdRws To 2 Step -1
        If Range("E" & i).Value Like "ITS####" Then
        Rows(i).EntireRow.Cut
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        ActiveSheet.Paste
        End If
        Next i
        On Error Resume Next



    sourceCol = 1
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

    'for every row, find the first blank cell and select it
    For currentRow = rowCount To 2 Step -1
        currentRowValue = Cells(currentRow, sourceCol).Value
        If IsEmpty(currentRowValue) Or currentRowValue = "" Then
            Rows(currentRow).EntireRow.Delete
        End If
    Next


        Range("a1").End(xlDown).Offset(1).EntireRow.Insert
        Range("a1").Select
        Selection.End(xlDown).Select
        Selection.End(xlDown).Select
        Selection.CurrentRegion.Select


        Sheets("O&M-Data").Select
        Range("J2").Select

'Works great to this point

    For i = 2 To (lastrowsheet1 - 1)
     For j = 2 To (lastrowsheet2 - 1)
        If Worksheets("O&M-Data").Cells(i, 10) = Worksheets("Capital-Data").Cells(j, 1) Then
        Selection.EntireRow.Cut
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        ActiveSheet.Paste
        End If
     Next
    Next
    For currentRow = rowCount To 2 Step -1
        currentRowValue = Cells(currentRow, sourceCol).Value
        If IsEmpty(currentRowValue) Or currentRowValue = "" Then
            Rows(currentRow).EntireRow.Delete
        End If
    Next
      Application.ScreenUpdating = True
End Sub

除最后一节外,所有方法均有效。做到这一点时,它仅复制表下方的“ O&M-Data”工作表的第一行,删除空白行,然后在总计下方插入空白行。似乎完全忽略了将该命令与“ Capital-Data”表匹配的命令。

如果有人可以告诉我如何将它们附加到这篇文章中,我可以提供两个小样本表。我认为,如果您可以看到这些数据,将会容易得多。

非常感谢您的协助!

1 个答案:

答案 0 :(得分:0)

编辑-已在示例工作簿上进行了更新和测试。

在比较和过滤完成之前,批量移动任何行都更加容易。

reset