Excel VBA質問箱 IV

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

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


23511 / 76738 ←次へ | 前へ→

【58593】Re:同じような手順をまとめたい
発言  ichinose  - 08/10/30(木) 20:32 -

引用なし
パスワード
   ▼まるん さん:
こんばんは。

>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    平井
>
>上記のようなエクセルがあります。
↑このシートをアクティブにした状態で以下のコードを実行してください。

標準モジュールに

'===========================================================
Sub main()
  Dim rngA As Range
  Dim rngB As Range
  Set rngA = Range("m1", Cells(Rows.Count, "m").End(xlUp))
  rngA.AdvancedFilter xlFilterCopy, , Worksheets("一覧").Range("a1"), True
  With Worksheets("一覧")
    With .Range("b1:m1")
     .Formula = "=column()-1&""月"""
     .Value = .Value
     End With
    Set rngB = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
    If rngB.Row > 1 Then
     With rngB.Offset(0, 1).Resize(, 12)
       .Formula = "=sumif(" & rngA.Address(, , , True) & ",$a2," & _
           rngA.Offset(, -12).Address(, False, , True) & ")"
       'セルb2には、=SUMIF(元データシート名!$M$1:$M$8,$A2,元データシート名!A$1:A$8)
       .Value = .Value
       End With
     End If
    End With
End Sub
2 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 発言

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