Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

23581 / 76807

←次へ　｜　前へ→


	【58592】同じような手順をまとめたい

まるん - 08/10/30(木) 19:49 -


	引用なし

	パスワード

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

0 hits

▼

【58592】同じような手順をまとめたい まるん 08/10/30(木) 19:49

≪