| |
▼マエ/ケン さん：
>難しいようで、可能でしょうか？
いえいえ、Sample3にちょっとだけ追加。
これで、合計があってもなくてもＯＫです。
Sub Sample4()
Dim v As Variant
Dim w() As Long
Dim gCnt As Long 'グループ数
Dim vTot() As Long
Dim vWk() As Long
Dim i As Long, x As Long, y As Long, z As Long
With Sheets("Sheet1") '<==実際のシート名に
x = .Cells(4, .Columns.Count).End(xlToLeft).Column
If .Cells(4, x).Value = "Total" Then
.Columns(x).ClearContents
x = x - 1
End If
gCnt = x - 4 - 1
ReDim vTot(1 To gCnt)
ReDim vWk(1 To gCnt)
y = .Range("A" & .Rows.Count).End(xlUp).Row
If .Cells(y, 1).Value = "合計" Then
.Rows(y).ClearContents
y = y - 1
End If
v = .Range("A5").Resize(y - 4, x).Value
ReDim w(LBound(v, 1) To UBound(v, 1))
For i = LBound(v, 1) To UBound(v, 1)
For z = 1 To gCnt
vWk(z) = v(i, 3) * v(i, z + 4)
w(i) = w(i) + vWk(z)
vTot(z) = vTot(z) + vWk(z)
Next
Next
.Cells(4, x + 1).Value = "Total"
.Cells(y + 1, 1).Value = "合計"
For i = 1 To gCnt
.Cells(y + 1, i + 4).Value = vTot(i)
Next
.Cells(5, x + 1).Resize(UBound(w)).Value = WorksheetFunction.Transpose(w)
End With
End Sub
|
|
UO3
- 11/4/11(月) 12:08 -
