|
▼nonoka さん:
こんにちは
転記先のシート上の場所が不明ですが想像で。
転記前に、転記先の書き込み領域のクリアをしておいたほうがいいのですが
手を抜いています。
Sub Sample()
Dim dic As Object
Dim c As Range
Dim v() As Variant
Dim z As Long
Dim key As String
Dim i As Long
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Shipped")
z = .Range("D" & .Rows.Count).End(xlUp).Row - 9 'データ行数
ReDim v(1 To z, 1 To 7) '転記用配列。行数は最大可能行数
For Each c In .Range("D10").Resize(z)
key = Join(WorksheetFunction.Index(c.Resize(, 4).Value, 1, 0), vbTab)
If Not dic.exists(key) Then dic(key) = dic.Count + 1 '配列行番号
i = dic(key)
v(i, 1) = c.Value
v(i, 2) = c.Offset(, 1).Value
v(1, 3) = c.Offset(, 2).Value
v(i, 4) = c.Offset(, 3).Value
v(i, 7) = v(i, 7) + c.Offset(, 6).Value
Next
End With
With Sheets("send list")
.Range("D10").Resize(UBound(v, 1), UBound(v, 2)).Value = v
.Select
End With
End Sub
|
|