|
▼nonoka さん:
上で質問したことについては想像で。
勘違いあれば指摘願います。
Sub 実績計算2()
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 5) '転記用配列。行数は最大可能行数
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(i, 3) = c.Offset(, 2).Value
v(i, 4) = c.Offset(, 3).Value
v(i, 5) = v(i, 5) + c.Offset(, 6).Value
Next
End With
With Sheets("send list")
With .Range("B5").Resize(UBound(v, 1), UBound(v, 2))
.Value = v
With .Columns(5).Font
.ColorIndex = xlAutomatic
.FontStyle = "標準"
End With
For Each c In .Columns(5).Resize(dic.Count).Cells
If c.Offset(, 1).Value > c.Value Then
c.Font.Color = vbRed
c.Font.FontStyle = "太字"
End If
c.Offset(, 1).FormulaR1C1 = "=RC[-2]-RC[-1]"
Next
.Parent.Select
End With
End With
End Sub
|
|