vba excel比较两个不同工作表中的列，然后在重复行计数中将行从一个列复制到另一个列

Two columns, separate sheets, each have part number in them. Column1 is updated and Column2 is copied from Column1 before Column1 is updated to retain associated row values and information per part number. Now if Column1 is updated and the row counts between Column1 and Column2 don't match anymore, I cannot find anything on comparing columns with different row counts where duplicates occur. How can I compare the columns and if there is a duplicate, take the duplicate row from Column2 and copy it to Column1 where the duplicate occurred(same part number)? Like if before Column1 was updated there was a part number 2222 in cell A1, so that data would be copied over to Column2 to A1. After the update of Column1 the part number 2222 might be in A8 now. Now the row counts don't match between columns, so I cannot do row count, and I cannot just copy a range over from one sheet to the other. Any help would be much appreciated.

两列,单独的纸张,每个都有部件号。更新Column1并在Column1更新之前从Column1复制Column2,以保留关联的行值和每个部件号的信息。现在,如果更新了Column1并且Column1和Column2之间的行数不再匹配,那么在比较具有重复项的不同行计数的列时,我找不到任何内容。如何比较列,如果有重复,请从Column2获取重复行并将其复制到发生重复的Column1(相同的部件号)?就像在Column1更新之前,在单元格A1中有一个部件号2222,因此数据将被复制到Column2到A1。更新Column1后,部件号2222现在可能在A8中。现在列数之间的行数不匹配,所以我不能进行行计数,而且我不能只将一个范围从一个工作表复制到另一个工作表。任何帮助将非常感激。

Sub DeleteRowsandCopyRowstoduplicate()

'Deletes rows where one cell does not meet criteria

Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("machine schedule")
Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sync Data")
Dim criteria As String
Dim found As Range
Dim i As Long

Application.ScreenUpdating = False

For i = 60 To 3 Step -1
   criteria = ws2.Cells(i, 1).Value
   On Error Resume Next
   Set found = ws1.Range("A:A").Find(What:=criteria, LookAt:=xlWhole)
   On Error GoTo 0
If found Is Not Nothing Then
    ws2.Cells(i, 1).EntireRow.Copy Destination:= '**not sure what to put here because it's always changing

If found Is Nothing Then
     ws2.Cells(i, 1).EntireRow.ClearContents ' or .Delete
   End If

  Next i

Application.ScreenUpdating = True

End Sub

1 个解决方案

#1

Your new info changes my understanding of the problem, so I've modified the macro accordingly. I've tested this and it gives the same output as what you posted in your links. Hopefully it does what you want.

您的新信息改变了我对问题的理解,因此我相应地修改了宏。我已对此进行了测试,它提供的结果与您在链接中发布的内容相同。希望它能做到你想要的。

Sub DeleteRowsandCopyRowstoduplicate()

' Deletes rows where one cell does not meet criteria

Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("machine schedule")
Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sync Data")
Dim criteria As String
Dim found As Range
Dim i As Long

    Application.ScreenUpdating = False

' Determine the number of row of updated data on ws 2
    ws2.Select
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    numb = Selection.Rows.Count

' Iterate through the data, when data from col A of ws2 is found to match data
' in col A of ws1, add data from all other columns to ws1
    For i = numb To 1 Step -1
        ws2.Select
        Cells(i, 1).Select
        ActiveCell.EntireRow.Copy
        criteria = ActiveCell

        my_marker = 1
        ws1.Select
        Range("A1").Select  ' or wherever it's appropriate to start
        Do Until IsEmpty(ActiveCell) = True
           If ActiveCell = criteria Then
                ActiveSheet.Paste
                my_marker = 2
                Exit Do
           Else
           End If
           ActiveCell.Offset(1, 0).Select
        Loop

        ws2.Select
        If my_marker = 1 Then
            ws2.Cells(i, 1).EntireRow.Delete
        Else
        End If
    Next i

' Remove any rows from ws1 that were not on ws2
    ws1.Select
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    numb2 = Selection.Rows.Count
    Range("B1").Select

    For i = 1 To numb2
        If IsEmpty(ActiveCell) = True Then
            ActiveCell.EntireRow.Delete
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Next
    Range("A1").Select

' sort ws2 by col A
    ws2.Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

    Range("A1").Select
    Application.ScreenUpdating = True
End Sub