Excel VBA質問箱 IV

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

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


40312 / 76732 ←次へ | 前へ→

【41519】Re:集計について
回答  かみちゃん E-MAIL  - 06/8/12(土) 19:34 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>※「交通費」から「交通費(製造)」にする
>
>に変更して、「勘定科目」をキーに集計すれば
>
>A        B    C    D    E     F   G
>部門コード   1201  1202  1203  1204   1205  合計
>交通費(製造)   30   50   100   200    300   680
>
>という表ができあがると思いますが・・・
>これをどのようにしたらいいのかということでしょうか?

とりあえず、以下のようなコードでできると思います。
元シートをSheet1、出力シートをSheet2とします。
なお、Sheet1はデータを書き換えますので、バックアップは取ってください。

Sub Macro1()
 Dim LastCell As Range
 Dim c As Range
 Dim cntBumon As Integer
 Dim strKey As String
 Dim vntData() As Variant
 Dim intCol As Integer
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet
 
 Set ws1 = Sheets("Sheet1")
 Set ws2 = Sheets("Sheet2")
 
 ws1.Activate
 cntBumon = Range("A1", Cells(1, Cells.Columns.Count).End(xlToLeft)).Columns.Count
 ws2.Range("A1").Resize(, cntBumon).Value = Range("A1").Resize(, cntBumon).Value
 
 Set LastCell = Cells(Cells.Rows.Count, 1).End(xlUp)
 For Each c In Range("A2", LastCell)
  If Right(c.Value, 4) <> "(製造)" Then
   c.Value = c.Value & "(製造)"
  End If
 Next
 For Each c In Range("A2", LastCell)
  '前行と勘定科目名が異なる場合、出力
  If strKey <> c.Value Then
   If c.Address <> "$A$2" Then
    ws2.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(vntData)).Value = vntData
   End If
   ReDim vntData(cntBumon) As Variant
   strKey = c.Value
  End If
  vntData(0) = c.Value
  For intCol = 2 To UBound(vntData) + 2 - 1
   vntData(intCol - 1) = vntData(intCol - 1) + c.Offset(, intCol - 1)
  Next
 Next
 ws2.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(vntData)).Value = vntData
 
 ws2.Activate
 MsgBox "集計終了"
End Sub

0 hits

【41515】集計について ToShiYo 06/8/12(土) 18:09 質問
【41517】Re:集計について かみちゃん 06/8/12(土) 18:19 発言
【41519】Re:集計について かみちゃん 06/8/12(土) 19:34 回答
【41518】Re:集計について Kein 06/8/12(土) 19:17 回答
【41521】Re:集計について Kein 06/8/12(土) 19:51 回答
【41553】Re:集計について ToShiYo 06/8/13(日) 7:31 お礼
【41554】Re:集計について かみちゃん 06/8/13(日) 9:26 発言
【41569】Re:集計について ToShiYo 06/8/13(日) 22:18 お礼

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