| 
    
     |  | ▼希椛(ののか) さん: 
 UO3 さんが考えておられる「セルに都度書き込まない」方法
 というのは(たぶんですが)こんなことかと思います。
 こうすると
 > Application.ScreenUpdating = False '/ True
 が不要になります。
 
 Sub Try1()
 Dim r As Range
 Dim v, ss As String
 Dim i As Long, j As Long, k As Long, n As Long
 Dim dic As Object
 
 Set dic = CreateObject("Scripting.Dictionary")
 With Range("A1").CurrentRegion.Resize(, 5)
 Set r = .Resize(, 4)
 v = .Value
 For i = 1 To r.Rows.Count
 ' [A+B+C+D]結合文字列
 ss = Join(Application.Index(r.Rows(i).Value, 0#))
 
 If dic.Exists(ss) Then '---- [A+B+C+D]が登録済みのとき
 n = dic(ss)
 v(n, 5) = v(n, 5) + v(i, 5) '加算
 
 Else         '----- [A+B+C+D]はじめてのとき
 k = k + 1
 dic(ss) = k      '辞書にkey[A+B+C+D]の行番号登録
 If i > 1 Then     '配列内 行移動
 For j = 1 To 5
 v(k, j) = v(i, j)
 Next
 End If
 End If
 Next
 .ClearContents
 .Resize(k).Value = v
 End With
 End Sub
 
 |  |