人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

【ExcelVBA】Book1の科目毎・タイトル毎に、Book2へ転記するマクロです。画像をご覧いただけますか。

≪Book1≫
科目ごとにシートが分かれています。
実際には、約50科目分あります。
シート名と[科目]列は、同じ文字列です。
[タイトル]の項目は、科目によってばらばらです。

≪Book2≫
給与毎・タイトル毎に、金額の合計を表示させます。



〔質問?〕
この作業をVBAに頼らずに行うとしたら、ピボットテーブルとVLOOKUPを使うのが効率のいい方法だと思ったので、
Book1内に、シート毎に新規シートにピボットテーブルを作成するマクロをつくるところまではできました。
しかし、どうやってVLOOKUPに持っていったらいいか全く見当がつきません。助けてください。



〔質問?〕
質問?のやりかたは邪道でしょうか。ほかにきれいなやりかたがあったら教えてください。
目的が達成できて、シンプルなコードであれば、?の方法にこだわりはありません。



下記?と?のどちらかでも構いませんので、ご教示いただけないでしょうか。よろしくお願いいたします。

1241612447
●拡大する

●質問者: ykdmmm
●カテゴリ:ビジネス・経営 コンピュータ
✍キーワード:VBA きれいな コード シンプル タイトル
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● Mook
●35ポイント ベストアンサー

どのような方法でも処理ができればよいと思いますので、

「質問?のやりかたは邪道」ということはないと思いますが、

マクロを使用した例です(ご期待に反していたらすみません)。


Book1 の標準モジュールに下記を置き、実行してみてください。

Option Explicit

'--------------------------------------------------------
Sub MakeSumBook()
'--------------------------------------------------------
 Dim srcWB As Workbook
 Set srcWB = ThisWorkbook
 
 Dim dstWB As Workbook
 Set dstWB = Workbooks.Add()
 
 Dim srcWS As Worksheet
 Dim dstWS As Worksheet
 Set dstWS = dstWB.Worksheets(1)

 dstWS.Range("A1:C1") = Array("科目", "タイトル", "タイトルごとの合計")
'--- 各シートごとに処理
 For Each srcWS In srcWB.Worksheets
 addWSSum srcWS, dstWS
 Next
End Sub

'--------------------------------------------------------
Sub addWSSum(srcWS As Worksheet, dstWS As Worksheet)
'--------------------------------------------------------
 Dim startRow As Long
 startRow = dstWS.Range("A" & Rows.Count).End(xlUp).Row + 1
 
 Dim lastRow As Long
 lastRow = srcWS.Range("C" & Rows.Count).End(xlUp).Row
 
 
'--- タイトルを検索
 Dim myDic As Object
 Set myDic = CreateObject("Scripting.Dictionary")
 
 Dim c As Variant
 For Each c In srcWS.Range("C2:C" & lastRow)
 If Not c = Empty Then
 If Not myDic.Exists(CStr(c)) Then
 myDic.Add CStr(c), Null
 End If
 End If
 Next
 
 Dim myKey As Variant
 myKey = myDic.Keys
 
 dstWS.Range("B" & startRow).Resize(myDic.Count) _
 = Application.WorksheetFunction.Transpose(myKey)
 Set myDic = Nothing
 
'--- タイトル毎に集計
 Dim dstLastRow
 dstLastRow = dstWS.Range("B" & Rows.Count).End(xlUp).Row
 
 Dim r As Long
 For r = startRow To dstLastRow
 dstWS.Cells(r, "A").Value = srcWS.Name
 dstWS.Cells(r, "C").Value = WorksheetFunction.SumIf( _
 srcWS.Range("C2").Resize(lastRow - 1, 1), _
 dstWS.Cells(r, "B").Value, _
 srcWS.Range("B2").Resize(lastRow - 1, 1))
 Next
 
'--- 小計列を追加
 dstWS.Cells(r, "A").Value = srcWS.Name
 dstWS.Cells(r, "B").Value = "小計"
 dstWS.Cells(r, "C").Formula = "=SUM( C" & startRow & ":C" & dstLastRow & ")"
End Sub
◎質問者からの返答

連想配列!そんな便利ものがあるんですか。

クロス集計=ピボットテーブルしか思い浮かびませんでした。

理解できるよう、勉強します。


2 ● SALINGER
●35ポイント

>Book2の、A、B列は既に存在していて

となるとVBAを使わない数式での方法でもできそうです。


まず、Book1にBook2の集計シートをコピーしたものを作ります。

A列B列は既にあるので、D列を作業列として

C2の数式

=IF(B2="小計",SUM(INDIRECT("D"& IF(ISNA(MATCH("小計",INDIRECT("B1:B"&ROW()-1),0)+1),2,MATCH("小計",INDIRECT("B1:B"&ROW()-1),0)+1) &":D"&ROW()-1)),D2)

D2の数式

=SUM(IF(INDIRECT(A2&"!C2:C1000")=B2,INDIRECT(A2&"!B2:B1000"),0))

として、Ctrl+Shilft+Enterで{}で囲い配列数式にします。

(1000というのは各シートの最大行よりも大きい数字を指定します)

後は、C2とD2を下方向にコピーします。


最後にできたABC列をBook2に値をコピーしたり、リンク貼り付けなどをすればいいです。

◎質問者からの返答

理解できるよう、勉強します。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ