☰

根据两列查找重复的行并将结果转移到另一个工作表

tag-icon • tag-icon microsoft-excel-2007 vba
根据两列查找重复的行并将结果转移到另一个工作表

我有一张工作表（“Saisie de Données”），其中 B 列和 D 列的数据有时是重复的。我希望能够识别这些重复项并对 G 列至 V 列中的数据求和。然后将结果传输到另一个工作表（“Sommaire - Paie”），该工作表将接收非重复行及其相关数据以及重复行及其求和结果。除了未复制到新工作表的 C 列之外，两个工作表之间的所有列都保持不变。每次启动宏时，第二个工作表（“Sommaire - Paie”）中的数据都将被覆盖。

我附上了工作表的副本，其中包含我手动创建的要分析的数据（“Saisie de Données”）和预期结果（“Sommaire - Paie”）。

要获取附件，请按照此 Dropbox 链接。

在真正的工作簿中，行数要多得多，但模式始终是相同的：工人的姓名以及他在一周内工作的时间。

答案1

我得到了一位名叫 Yoyo Jiang 的人的帮助，代码运行完美。这是我使用的代码：

Private Sub TestSumDuplicate()

Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = ThisWorkbook.Worksheets("Saisie de Données")
Set WS2 = ThisWorkbook.Worksheets("Sommaire - Paie (2)")

Dim oRange1 As Range
Dim oRange2 As Range
Dim tempRange As Range

Set oRange2 = WS2.Range("A29", "U110")
oRange2.ClearContents
Set oRange1 = WS1.Range("A30", "V553")

Dim i As Integer
Dim j As Integer
Dim t As Integer
Dim m As Integer
Dim n As Integer

Dim bFlag As Boolean

' j to record the current relative row location in oRange2
j = 1

For i = 0 To oRange1.Rows.Count - 1

bFlag = False '' to record if there is already a same category in oRange2.

If Not oRange1.Cells(i, 2) = "" Then
If Not oRange1.Cells(i, 2) = "Ligne Sommaire" Then

'' If it a row need to be check
For t = 1 To j
If oRange2.Cells(t, 3) = oRange1.Cells(i, 4) And oRange2.Cells(t, 2) = oRange1.Cells(i, 2) Then
bFlag = True

    '' Sum if duplicate
    For m = 0 To 18
    If Not oRange1.Cells(i, 7 + m) = "" Then
        oRange2.Cells(t, 6 + m) = oRange1.Cells(i, 7 + m) + oRange2.Cells(t, 6 + m)
    End If
    Next m

Exit For
End If
Next t

If bFlag = True Then
    bFlag = False
Else
    '' doesn't find a duplicate value
    oRange2.Cells(j, 1) = oRange1.Cells(i, 1)
    oRange2.Cells(j, 2) = oRange1.Cells(i, 2)

    For m = 4 To 25
     oRange2.Cells(j, m - 1) = oRange1.Cells(i, m)
    Next m

    j = j + 1
End If

End If
End If
Next i

End Sub

相关内容