|
1月 2月 3月・・・ 12月 担当
100 200 100 田中
50 45 80 佐藤
80 78 90 池田
400 30 50 田中
200 36 40 清水
80 34 67 佐藤
70 12 45 平井
上記のようなエクセルがあります。
別シート(シート名は"一覧")に担当ごとに各月の合計を
転記したく、コードを書きました。
転記結果です。
担当 1月 2月 3月・・ 12月
田中 500 230 150
佐藤 130 79 147
が、担当は30名ほどいて
私のこのコードでは
まとまりがなく、無駄なようでわかりにくいのです。
なにかいい知恵がございましたら
ぜひ教えていただきたく、書かせて頂きました。
よろしくお願いいたします。
Sub test()
Dim MRow As Long
Dim Rng As Range
Dim A, B, C, D, E, F, G, H, I, J, K, L As Variant
Dim A1, B1, C1, D1, E1, F1, G1, H1, I1, J1, K1, L1 As Variant
MRow = Cells(65536, 1).End(xlUp).Row
For Each Rng In Range(Cells(2, 13), Cells(MRow, 13))
If Rng.Value = "田中" Then
A = A + Rng.Offset(, -12)
B = B + Rng.Offset(, -11)
C = C + Rng.Offset(, -10)
D = D + Rng.Offset(, -9)
:
K = K + Rng.Offset(, -2)
L = L + Rng.Offset(, -1)
Worksheet("一覧").Range("B2").Resize(, 12) = Array(A, B, C, D, E, F, G, H, I, J, K, L)
ElseIf Rng.Value = "佐藤" Then
A1 = A1 + Rng.Offset(, -12)
B1 = B1 + Rng.Offset(, -11)
C1 = C1 + Rng.Offset(, -10)
D1 = D1 + Rng.Offset(, -9)
:
K1 = K1 + Rng.Offset(, -2)
L1 = L1 + Rng.Offset(, -1)
Worksheet("一覧").Range("B3").Resize(, 12) = Array(A1, B1, C1, D1, E1, F1, G1, H1, I1, J1, K1, L1)
'Eleseifが人数分続きます。
End If
Next
End Sub
|
|