| |
▼nonoka さん：
おはようございます。
まだ、勘違いがあるかもしれません。
コード記述としては、できる限り、【列記号】で書きましたので
列の勘違いがあれば修正願います。
式は、H列にセットしていますが、最初は空白の結果になります。
コード実行後、G列に何か値がはいれば、引き算の結果がH列に表示されます。
Sub 実績計算3()
Dim dic As Object
Dim c As Range
Dim v() As Variant
Dim z As Long
Dim key As String
Dim i As Long
Dim n 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")
n = UBound(v, 1) '行数
.Range("B5").Resize(n, UBound(v, 2)).Value = v
With .Range("F5").Resize(n).Font
.ColorIndex = xlAutomatic
.FontStyle = "標準"
End With
For Each c In .Range("F5").Resize(dic.Count, UBound(v, 2))
With c.EntireRow
If .Range("F1").Value < .Range("E1").Value Then
.Range("F1").Font.Color = vbRed
.Range("F1").Font.FontStyle = "太字"
End If
End With
Next
.Range("H5").Resize(dic.Count).Formula = "=IF(G5=0,"""",F5-G5)"
.Select
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
