☰

2つの列に基づいて重複行を検索し、結果を別のワークシートに転送します。

tag-icon • tag-icon microsoft-excel-2007 vba
2つの列に基づいて重複行を検索し、結果を別のワークシートに転送します。

重複することがある列 B と D のデータを含むワークシート ("Saisie de Données") があります。これらの重複を認識し、列 G から V までのデータを合計できるようにしたいと考えています。その結果は別のワークシート ("Sommaire - Paie") に転送され、関連データを含む重複していない行と、合計結果を含む重複行を受け取ります。新しいワークシートにコピーされない列 C を除き、2 つのワークシート間ですべての列は同じままです。マクロが起動されるたびに、2 番目のワークシート ("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

関連情報