Excel VBA質問箱 IV

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

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


23506 / 76732 ←次へ | 前へ→

【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 質問
【58593】Re:同じような手順をまとめたい ichinose 08/10/30(木) 20:32 発言
【58598】Re:同じような手順をまとめたい まるん 08/10/30(木) 22:10 発言
【58604】Re:同じような手順をまとめたい ichinose 08/10/31(金) 7:02 発言

23506 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free