☰

根據兩列尋找重複行並將結果傳送到另一個工作表中

tag-icon • tag-icon microsoft-excel-2007 vba
根據兩列尋找重複行並將結果傳送到另一個工作表中

我有一個工作表（“Saisie de Données”），其中 B 列和 D 列中的資料有時是重複的。我希望能夠識別這些重複項並對 G 列到 V 列中的資料求和。具有總和結果的重複行。除了未複製到新工作表的列 C 之外，兩個工作表之間的所有列都保持相同。每次啟動巨集時，第二個工作表（「Sommaire - Paie」）中的資料將被覆寫。

我附上了工作表的副本，其中包含要分析的數據（“Saisie de Données”）和我手動創建的預期結果（“Sommaire - Paie”）。

若要取得附件，請依照這個保管箱連結。

在真正的工作簿中，有更多的行，但總是相同的模式：工人的名字和他在一周內工作的時間。

答案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

相關內容