Excel VBA質問箱 IV

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

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


7047 / 13646 ツリー ←次へ | 前へ→

【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 お礼[未読]

【41515】集計について
質問  ToShiYo  - 06/8/12(土) 18:09 -

引用なし
パスワード
   製造原価を集計するに当たり、一般管理費から一部製造にその関連する
経費が、振り分けられてきます。
下の表はその一部を表示しています。
一般管理費のものは製造部門の個々の勘定科目に下の欄に加えられている
状態でエクセルで仕上げています。開発費は一般管理費から振り代えられ
ないため一行の集計になっています。

A        B    C    D    E     F   G
部門コード   1201  1202  1203  1204   1205  合計

交通費(製造)          100   200    300   600
交通費     30   50                  80 

事務費(製造)           30   25    15    70
事務費     10   5                  15

開発費(製造)          300   200   100   600 



合計

この上の表を次のような表に仕上げたい(勘定科目を2行使わず1行にする
一般管理費から振り返られてきた数字を、製造の原価に入れて一行仕上げ
に仕上げる)のですが・・・どのような方法で仕上げたらよいか教えてく
ださい。

A        B    C    D    E     F   G
部門コード   1201  1202  1203  1204   1205  合計
交通費(製造)  30   50   100   200   300   680
事務費(製造)  10    5    30   25    15    85
開発費(製造)          300   200   100   600   


合計

勘定科目の順番は特に指定ありません。昇順に並んでいれば分かりやすいです。
勘定科目は全部で40くらいですが月により週により対象の勘定科目が発生しない
場合もあり、変動します(37勘定科目のときもあります)。

よろしくお願いします。

【41517】Re:集計について
発言  かみちゃん E-MAIL  - 06/8/12(土) 18:19 -

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

> 勘定科目を2行使わず1行にする一般管理費から振り返られてきた数字を、製造
> の原価に入れて一行仕上げに仕上げる

私も仕事で原価計算の集計をしていますので、なんとなくなさりたいことはわかります。

「勘定科目」に「(製造)」がつくものとつかないものがあって、

A        B    C    D    E     F   G
部門コード   1201  1202  1203  1204   1205  合計
交通費(製造)          100   200    300   600
交通費      30   50                80 

この表を

A        B    C    D    E     F   G
部門コード   1201  1202  1203  1204   1205  合計
交通費(製造)          100   200    300   600
交通費(製造)   30   50                80 
 ↑
※「交通費」から「交通費(製造)」にする

に変更して、「勘定科目」をキーに集計すれば

A        B    C    D    E     F   G
部門コード   1201  1202  1203  1204   1205  合計
交通費(製造)   30   50   100   200    300   680

という表ができあがると思いますが・・・
これをどのようにしたらいいのかということでしょうか?

【41518】Re:集計について
回答  Kein  - 06/8/12(土) 19:17 -

引用なし
パスワード
   そのサンプルデータを見た限りにおいて、ベタ書きでコードを組んでみます。

Sub Test()
  Dim MyR As Range
  Dim ER As Long

  Application.ScreenUpdating = False
  Range("G:G").ClearContents
  Range("A65536").End(xlUp).EntireRow.ClearContents
  With Range("A2", Range("A65536").End(xlUp)).Offset(, 1)
   Set MyR = .SpecialCells(2, 1)
   .Resize(, 2).SpecialCells(4).FormulaR1C1 = "=R[1]C"
   .Resize(, 2).Copy
   Range("B2").PasteSpecial xlPasteValues
   MyR.EntireRow.Delete xlShiftUp
  End With
  Set MyR = Nothing
  With Range("A65536").End(xlUp).Offset(1)
   ER = .Row - 1
   .Value = "合計"
   .Offset(, 1).Resize(, 5).Formula = "=SUM(B2:B" & ER & ")"
  End With
  With Range("G1")
   .Value = "合計"
   .Offset(1).Resize(ER - 1).Formula = "=SUM(B2:F2)"
  End With
  With Application
   .CutCopyMode = False
   .ScreenUpdating = True
  End With
End Sub

【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

【41521】Re:集計について
回答  Kein  - 06/8/12(土) 19:51 -

引用なし
パスワード
   どちらかと言うと↓この方が分かりやすいですね。

Sub MyDataSet()
  Dim MyR As Range, C As Range
 
  Application.ScreenUpdating = False
  Range("G2:G65536").ClearContents
  Set MyR = Range("A2", Range("A65536").End(xlUp).Offset(-1)) _
  .Offset(, 1).SpecialCells(2, 1)
  For Each C In MyR
   C.Resize(, 5).Copy
   C.Offset(-1).PasteSpecial xlPasteValues, _
   xlPasteSpecialOperationAdd
   Application.CutCopyMode = False
  Next
  MyR.EntireRow.Delete xlShiftUp: Set MyR = Nothing
  Range("A2", Range("A65536").End(xlUp).Offset(-1)) _
  .Offset(, 6).Formula = "=SUM($B2:$F2)"
  ActiveSheet.Calculate: Range("A1").Select
  Application.ScreenUpdating = True
End Sub

【41553】Re:集計について
お礼  ToShiYo  - 06/8/13(日) 7:31 -

引用なし
パスワード
   ▼Kein さん かみちゃんさん

ありがとうございました。
今、実際の作業に照らしあわせて、見させていただいています。
分からない部分が出てきましたらまたお聞きさせていただきたいと
思います。その時にはさらによろしくお願いします。

今、ひとつ分からないことがあります…
いつも疑問に思っていたのですが
SpecialCells(2, 1)は何を表しているのでしょうか。
ヘルプで見てもでてきませんが、検索の仕方が悪いのでしょうか?
よろしくお願いします。

【41554】Re:集計について
発言  かみちゃん  - 06/8/13(日) 9:26 -

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

横から失礼します。

>SpecialCells(2, 1)は何を表しているのでしょうか。

数値定数と文字定数の違いですが、これは、賛否両論あるところです。
コードだけ読むと数値だとわかりづらいので、ヘルプにも書かれている文字定数を
使うと、コード実行時には、文字を数値に置き換えて実行するということをしてい
るようなので、初めから数値定数を指定しておけばいいのではないかという考え方
かと思います。

可読性なのか処理速度か、賛否両論かと思います。

なお、対応表は、以下のような感じです。
以前Keinさんに教えていただいたものです。

[第一引数]
xlCellTypeConstants = 2
xlCellTypeFormulas = 3
xlCellTypeBlanks = 4
xlCellTypeLastCell = 11
xlCellTypeVisible = 12
xlCellTypeComments = -4144
xlCellTypeAllFormatConditions = -4172
xlCellTypeSameFormatConditions = -4173
xlCellTypeAllValidation = -4174
xlCellTypeSameValidation = -4175

[第二引数]
xlNumbers = 1
xlTextValues = 2
xlLogical = 4
xlErrors = 16

【41569】Re:集計について
お礼  ToShiYo  - 06/8/13(日) 22:18 -

引用なし
パスワード
   ▼かみちゃん さん:

よく分かりました。
ご丁寧な解説で本当に良く分かりました。
今後ともよろしくお願いします。

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