重複行を見つけて、別の列vbaの結果を集計します。Excel

Question

私はいくつかのウェブサイトとブログを見て、サンプルコードを出して下に投稿しました。

私は、18000行と26列の巨大なデータを持っています。私は、これらの3つの列の行が同じである場合、列（B、F、G）に基づいて重複行を見つけなければならない。重複行に別の列のセルの値を集計し、唯一の重複する行を保持する。

サンプルデータ：

A(Name)  B(Mat_Num) C(Items) D(group) E(Summon) F(Plant) G(Batch_num) 
1.Ram  1235   HA1  Micro  545.5  1327  893A1 
2.ram  12354  rt2  Senf  5678  0001  1063F 
3.Joseph 12354  cf1  Macro  9844  0001  1063F 
4.andreas 12354  dw1  HR   6633.95 0001  1063F 
5.John  1235   ff1  Finance 22555.09 1327  893A1 
6.Russel  987   ad1  Sales  6423  0001  jjg67 
7.Holger  00   dd1  purchase 3333  1327  dd567 
8.Gottfried 234  fa1  rot  663  345  45678 

結果：あなたは、列Eが表示される場合は、列（B、F、G）に基づいて、重複行が列Eに

A(Name)  B(Mat_Num) C(Items) D(group) E(Summon) F(Plant) G(Batch_num) 
1.Ram  1235   HA1  Micro  23101  1327  893A1 
2.ram  12354  rt2  Senf  22155.95 0001  1063F 

合計され残りの重複行を削除する必要があります。

コード： ここに私のコードです。私はそれを理解することができませんでした。誰もアルゴリズムの効果的な方法で私を助けることができます。

Sub Sample() 
    Dim LastRowcheck As Long, n1 As Long 
    Dim DelRange As Range 

    With Worksheets("Sheet1") 
     LastRowcheck = .Range("A" & .Rows.Count).End(xlUp).Row 

     For n1 = 1 To LastRowcheck 
      If .Cells(n1, 1).Value = Cells(n1 + 1, 1).Value Then 
       If DelRange Is Nothing Then 
        Set DelRange = .Rows(n1) 
       Else 
        Set DelRange = Union(DelRange, .Rows(n1)) 
       End If 
      End If 
     Next n1 

     If Not DelRange Is Nothing Then DelRange.Delete 
    End With 
End Sub 

私を助けてください。

Answer 1

これはすぐにそれを処理する必要があります。 18K行のデータをまとめて集計することができます。

Sub Sum_and_Dedupe() 
    With Worksheets("sheet1") 
     'deal with the block of data radiating out from A1 
     With .Cells(1, 1).CurrentRegion 
      'step off the header and make one column wider 
      With .Resize(.Rows.Count - 1, .Columns.Count + 1).Offset(1, 0) 
       .Columns(.Columns.Count).Formula = "=sumifs(e:e, b:b, b2, f:f, f2, g:g, g2)" 
       .Columns(5) = .Columns(.Columns.Count).Value 
       .Columns(.Columns.Count).Delete 
      End With 

      'remove duplicates 
      .RemoveDuplicates Columns:=Array(2, 6, 7), Header:=xlYes 
     End With 
     .UsedRange 
    End With 
End Sub 

18K行のランダムデータでは18秒かかりました。あなた自身の結果は、ハードウェアとソフトウェアによって異なりますが、それは野球場でなければなりません。 Sum_and_Dedupe前

^{サンプル・データ（）Sum_and_Dedupe後}

^{サンプル・データ（）}

Answer 2

ここで "球場は" ＃2

Sub main() 
Dim helperRng As Range 

With Worksheets("Sheet01") 
    With .UsedRange 
     Set helperRng = .Offset(, .Columns.Count + 1).Resize(, 1) 
     With helperRng 
      .FormulaR1C1 = "=concatenate(RC2, RC6, RC7)" 
      .Offset(, 1).FormulaR1C1 = "=if(countif(R1C[-1]:RC[-1], RC[-1])=1,1,"""")" 
      With .Offset(, 2) 
       .FormulaR1C1 = "=sumif(C[-2], RC[-2],C5)" 
       .Value = .Value 
      End With 
      .Offset(, 1).SpecialCells(xlCellTypeFormulas, xlTextValues).EntireRow.Delete 
      Worksheets("Sheet01").Columns(5).Resize(.Rows.Count - 1).Offset(1).Value = .Offset(1, 2).Resize(.Rows.Count - 1).Value 
      helperRng.Resize(, 3).Clear 
     End With 
    End With 
End With 

End Sub 

のみ、Cの気分が早い！