Question

目前，我正在从我们的一个数据库收到每月转储，其中包含我们所有的有效公共传输订阅。我的任务是将这些上传到SAP，但只有与上个月相比的值不同。因此，应该拾取所有新订阅，并且与上个月相比，其中一个不同列中的一个值的所有订阅都不同。如果行完全相同，我就不需要了。

我收到的文件包含7列，列A包含每位员工的唯一密钥。

我想使用VBA来比较两个excel文件，方法是粘贴上个月Sheet1中的文件和Sheet2中本月的文件。我想找到相同的行并将其从Sheet2中删除。

我已经找到了一些VBA代码执行此操作的示例，但似乎没有任何正常工作。下面的一个是我使用的最后一个，在下面的代码行Do While Not IsEmpty(wsA.Range(keyColA & intRowCounterA).Value)上给出了语法错误。

Sub CleanDupes()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim keyColA As String
Dim keyColB As String
Dim rngA As Range
Dim rngB As Range
Dim intRowCounterA As Integer
Dim intRowCounterB As Integer
Dim strValueA As String


keyColA = "A"
keyColB = "B"

intRowCounterA = 1
intRowCounterB = 1

Set wsA = Worksheets("Sheet1")
Set wsB = Worksheets("Sheet2")

Do While Not IsEmpty(wsA.Range(keyColA & intRowCounterA).Value)
    intRowCounterB = 1
    Set rngA = wsA.Range(keyColA & intRowCounterA)
    strValueA = rngA.Value
    Do While Not IsEmpty(wsB.Range(keyColB & intRowCounterB).Value
        Set rngB = wsB.Range(keyColB & intRowCounterB)
        If strValueA = rngB.Value Then
             'Code to delete row goes here, but I'm not sure exactly'
             'what it is.'
             wsB.Range(Rows(intRowCounterB)).EntireRow.Delete
             intRowCounterB = intRowCounterB - 1
        End If
        intRowCounterB = intRowCounterB + 1
    Loop
    intRowCounterA = intRowCounterA + 1
Loop

End Sub

有什么想法吗？

尼克

Answer 1

下面的代码在Sheet1中找到来自Sheet2的重复行。它将Sheet1.Row(id)连接的所有行值与Sheet2.Row(id)连接的所有行值进行比较

最后，它将重复项移动到名为模式"Sheet2 Dupes - yyyymmdd-hhmmss"的新工作表（当前日期时间）

Public Sub RemoveDuplicateRows()
    Dim ur1 As Range, ur2 As Range, dupeRows As Range
    Dim r1 As Range, s1 As String, r2 As Range, s2 As String

    Set ur1 = Worksheets("Sheet1").UsedRange.Rows
    Set ur2 = Worksheets("Sheet2").UsedRange.Rows  'Find duplicates from Sheet1 in Sheet2

    Set dupeRows = ur2(Worksheets("Sheet2").UsedRange.Rows.Count + 1)
    For Each r1 In ur1
        s1 = Join(Application.Transpose(Application.Transpose(r1)))
        For Each r2 In ur2
            s2 = Join(Application.Transpose(Application.Transpose(r2)))
            If s1 = s2 Then
                If Intersect(dupeRows, r2) Is Nothing Then
                    Set dupeRows = Union(dupeRows, r2)
                End If
            End If
        Next
    Next

    Dim wb As Workbook, wsDupes As Worksheet    'Move duplicate rows to new Sheet
    Application.ScreenUpdating = False
    Set wb = ThisWorkbook
    Set wsDupes = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
    wsDupes.Name = "Sheet2 Dupes - " & Format(Now, "yyyymmdd-hhmmss")
    dupeRows.Copy
    With wsDupes.Cells(1)
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteColumnWidths
        .Select
    End With
    dupeRows.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

Excel / VBA从多个工作表中删除重复的行

1 个答案: