[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAを使用し、異なる「報告書」データーの合計金額を、別のシートの【集計表】として一覧にしたいです。』（りりちゃん☆彡）
いつもお世話になっております。
りりちゃん☆彡と申します。
早速ではございますが、以下の件についてご存知の方がいらっしゃったら
教えていただけませんでしょうか。
自分で一生懸命頑張りましたが、同一シートで報告書1と2を両方とも集計できるやり方が
分からず困っています。
私がやりたいことは以下の通りです。
・同一フォルダ内に
報告書?@
・G日々○○管理報告書ファイル
・費用シートの（合計金額）am2欄。
報告書?A
・P日々◆◆管理計算書ファイル
・出力シートの（合計金額）f12欄。
と言うシートが、どちらも複数あります。
ちなみにファイル名は、最初にG日々○○管理報告書〜とか、P日々◆◆管理計算書〜問う風にどちらもアルファベットがついています。
これを「合計金額」部分のみ集計したいです。
・4月集計表
・a列ファイル名、b列各シートに記載されている、合計金額。
例
A列 B列
G日々○○管理報告書【うさぎ】.xlsm 48,000
P日々◆◆管理計算書【猫】.xlsm 100,000
P日々◆◆管理計算書【犬】.xlsm 100,000
合計集計 248,000
という感じです。
私が書いたのは以下です。今の所、
片方づつなら集計できるようにはなっています。
ですが、本当はシート1で両方とも集計したいです。
Sub folder() '集計したいファイルがあるフォルダを指定
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
Range("F1").Value = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Sub
Sub 日々管理報告書集計()
'フォルダの場所を変数に入れる
Dim Folder_path As String
Folder_path = Range("F1").Value
'シートの警告ダイアログ非表示設定。
Application.DisplayAlerts = False
'シートを開かずに値だけを貼り付ける。
Application.ScreenUpdating = False
'集計先のシートを指定し、変数に入れる
Dim w
Set w = Worksheets("集計表")
'集計するブックを変数に入れる
Dim Merge_book As String
Merge_book = Dir(Folder_path & "\*.xls*")
'いったん数値をクリア
w.Range("a2", "b" & Rows.Count).Clear
'集計先のシートの1行からスタート
Dim n
n = 2
'指定したフォルダから、Excdelファイルを探す
Do Until Merge_book = ""
Workbooks.Open Filename:=Folder_path & "\" & Merge_book
'見つかったら、A列にファイル名、B列に集計値を入れる
w.Range("a" & n).Value = Merge_book
w.Range("b" & n).Value = Workbooks(Merge_book).Worksheets("費用").Range("am2").Value
'次の行へ
n = n + 1
'シートの警告ダイアログ表示設定になおす？これひつようなのかな？
Application.DisplayAlerts = True
'集計するブックを閉じる
Workbooks(Merge_book).Close
'次のファイルを探しに行く
Merge_book = Dir()
Loop
'B列の最終行に金額の集計を入れる。
Range("B1").End(xlDown).Offset(1, 0) = _
"=SUM(" & Range(Range("B1"), Range("B2").End(xlDown)).Address(False, False) & ")"
'A列の最終行に集計の合計を入れる。
Range("A1").End(xlDown).Offset(1, 0) = "合計集計"
End Sub
以上です。お忙しい所申し訳ないのですがどうぞよろしくお願い致します。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
（γ） 2016/04/14(木) 21:49
γさんから指摘がありますが、このコードでは、対象のフォルダ内のエクセルブックをすべて相手にしてしまいます。 もし、ほかの関係のないブックも混在していれば、対象ブックかどうかのふるいをかけておくことが必要なんですが
>>片方づつなら集計できるようにはなっています。
ということですので、対象ブックしかないという前提で。
βの好みで、変数定義は 最初にまとめました。変数のデータ型も省略せず明示しましょう。
なお、オリジナルコードでは フォルダを選択した結果を F1 に書きこんでおき、そこを参照するロジックになっていますが 勝手に、フォルダ選択をファンクションプロシジャにして、実行マクロから、それを呼び出すようにしています。
Function folder() As String '集計したいファイルがあるフォルダを指定
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
folder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Function
Sub 日々管理報告書集計()
Dim w As Worksheet
Dim n As Long
Dim Merge_book As String
Dim Folder_path As String
Dim mx As Long
'フォルダの場所を変数に入れる
Folder_path = folder
If Folder_path = "" Then Exit Sub 'フォルダダイアログでキャンセルボタンが押された
'マクロブックを開くので万が一イベントプロシジャ等があった場合に備えて
Application.EnableEvents = False
'処理中の画面の動きを隠す
Application.ScreenUpdating = False
'集計先のシートを指定し、変数に入れる
Set w = ThisWorkbook.Worksheets("集計表") 'ThisWorkbook修飾はこのマクロ自体では不要ですが、複数ブックを扱う処理なのでわかりやすくするために。
'いったん数値をクリア
w.Range("a2", "c" & Rows.Count).Clear
'集計するブックを変数に入れる
Merge_book = Dir(Folder_path & "\*.xls*")
'集計先のシートの2行からスタート
n = 2
'指定したフォルダから、Excdelファイルを探す
Do Until Merge_book = ""
Workbooks.Open Filename:=Folder_path & "\" & Merge_book
'見つかったら、A列にファイル名、B列に集計値を入れる
w.Range("a" & n).Value = Merge_book
w.Range("b" & n).Value = Workbooks(Merge_book).Worksheets("費用").Range("am2").Value
w.Range("c" & n).Value = Workbooks(Merge_book).Worksheets("出力").Range("f12").Value
'次の行へ
n = n + 1
'集計するブックを閉じる
Workbooks(Merge_book).Close False '揮発性関数等があった場合の保存メッセージを回避。保存なしで閉じる。
'次のファイルを探しに行く
Merge_book = Dir()
Loop
'集計表シートの最終行
mx = w.Range("A" & w.Rows.Count).End(xlUp).Row
'B列,C列の最終行の下に金額の集計を入れる。
w.Range("B" & mx + 1).Formula = "=SUM(B2:B" & mx & ")"
w.Range("C" & mx + 1).Formula = "=SUM(C2:C" & mx & ")"
'A列の最終行の下に集計の合計を入れる。
w.Range("A" & mx + 1).Value = "合計集計"
'イベント発生再開
Application.EnableEvents = False
End Sub
（β） 2016/04/16(土) 17:44
↑ あっ！！！
もしかして、ブックは頭に G がつくものとPがつくものだけがあって Gがつくものは 費用シートの AM2、Pがつくものは 出力シートの F12 から、ともに B列にもってきて １列で合算ということでしたか！
それように訂正したものを後ほどアップします。
（β） 2016/04/16(土) 17:50
日々管理報告書集計 のみ 置き換えてください。older はアップしたものと変更なし。
Sub 日々管理報告書集計()
Dim w As Worksheet
Dim n As Long
Dim Merge_book As String
Dim Folder_path As String
Dim mx As Long
Dim target As Range
'フォルダの場所を変数に入れる
Folder_path = folder
If Folder_path = "" Then Exit Sub 'フォルダダイアログでキャンセルボタンが押された
'マクロブックを開くので万が一イベントプロシジャ等があった場合に備えて
Application.EnableEvents = False
'処理中の画面の動きを隠す
Application.ScreenUpdating = False
'集計先のシートを指定し、変数に入れる
Set w = ThisWorkbook.Worksheets("集計表") 'ThisWorkbook修飾はこのマクロ自体では不要ですが、複数ブックを扱う処理なのでわかりやすくするために。
'いったん数値をクリア
w.Range("a2", "b" & Rows.Count).Clear
'集計するブックを変数に入れる
Merge_book = Dir(Folder_path & "\*.xls*")
'集計先のシートの2行からスタート
n = 2
'指定したフォルダから、Excdelファイルを探す
Do Until Merge_book = ""
Workbooks.Open Filename:=Folder_path & "\" & Merge_book
Set target = Nothing
Select Case Left(Merge_book, 1)
Case "G": Set target = Workbooks(Merge_book).Worksheets("費用").Range("am2")
Case "P": Set target = Workbooks(Merge_book).Worksheets("出力").Range("f12")
End Select
If Not target Is Nothing Then '念のため、G,P以外のブックは対象外
'見つかったら、A列にファイル名、B列に集計値を入れる
w.Range("a" & n).Value = Merge_book
w.Range("b" & n).Value = target.Value
'次の行へ
n = n + 1
End If
'集計するブックを閉じる
Workbooks(Merge_book).Close False '揮発性関数等があった場合の保存メッセージを回避。保存なしで閉じる。
'次のファイルを探しに行く
Merge_book = Dir()
Loop
'集計表シートの最終行
mx = w.Range("A" & w.Rows.Count).End(xlUp).Row
'B列,C列の最終行の下に金額の集計を入れる。
w.Range("B" & mx + 1).Formula = "=SUM(B2:B" & mx & ")"
'A列の最終行の下に集計の合計を入れる。
w.Range("A" & mx + 1).Value = "合計集計"
'イベント発生再開
Application.EnableEvents = False
End Sub
（β） 2016/04/16(土) 18:10
いつもお世話になっております。
VBA超初心者の、りりちゃん☆彡です。
この度もお世話になりありがとうございます。
昨日は、歓迎会だったためご連絡できずにすみませんでした。
（γ）様
お世話になっております。
私がやりたいことは（γ）様がおっしゃっていることで間違いないです。
本で知ったIFっていうので分岐っていうのをすればできるのかな？とは思っていましたが、
IF関数というので書きだす（？）ところですでに？？となってしまい。
またここを頼ってしまいました。
ご指導いただきありがとうございました。
（β） 様
お世話になっております。
お忙しい中コード書いて下さってどうもありがとうございました。
さっきやってみたのですが
'フォルダの場所を変数に入れる
Folder_path = folder
と言う所で
ファンクションまたは変数がどうのこうのと、黄色くなってしまいました(/_;)
どうすればいいでしょうか。
すみませんが教えてください。
りりからお二人へ♪
この度は色々とお忙しい中ありがとうございます。りりちゃん☆彡は、VBA超初心者です。
今の所よくわかるVBAの本を、入門と実践と頑張りましたが書いてあるものを、
打ち込みして本の通りにできるようになりましたが、自分のやりたいことになると？？
どうやればいいのかなとなってしまって、全然できていません。
そんな私なので、本当を言うと（γ）様が教えてくださった、
・LEFT関数で文字を取り出して、
・If文でそれに応じて、別のセルからデータを引っ張るように変更すればよろしいのでは？
ここの事はおっしゃっていることすら全然理解できなくてせっかく教えてくださったのにすみません。
頑張っているつもりなのに、全然できていないっていうりりちゃん☆彡なのでした。。。。
また色々とご指導いただけたら嬉しいです。
りりちゃん☆彡より
（りりちゃん☆彡） 2016/04/16(土) 21:49
If Left(Merge_book, 1) = "G" Then
w.Range("b" & n).Value = Workbooks(Merge_book).Worksheets("費用").Range("am2").Value
ElseIf Left(Merge_book, 1) = "P" Then
w.Range("b" & n).Value = Workbooks(Merge_book).Worksheets("出力").Range("f12").Value
End If
Select Caseステートメントのほうが綺麗なので、そちらをお勧めですが、
その前の段階で、上のようなものもあるかもしれませんね。
（γ） 2016/04/16(土) 22:06
γさんのコメントの前にメモしましたので、かぶりましたし、でしゃばりですが、そこも含めて。
>>ファンクションまたは変数がどうのこうのと、黄色くなってしまいました
以下のコードも記述しましたか？
Function folder() As String '集計したいファイルがあるフォルダを指定
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
folder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Function
ところで、
>>（γ）様が教えてくださった、 >> ・LEFT関数で文字を取り出して、 >> ・If文でそれに応じて、別のセルからデータを引っ張るように変更すればよろしいのでは？ >> ここの事はおっしゃっていることすら全然理解できなくてせっかく教えてくださったのにすみません。
こちらのほうがわかりやすいかもしれませんね。 その条件分岐にしたコード、参考まで。（このコードも folder プロシジャを使います） アップ済みのコードと、すこ〜し、異なっているところがあります。比べてみてください。
Sub 日々管理報告書集計2()
Dim w As Worksheet
Dim n As Long
Dim Merge_book As String
Dim Folder_path As String
Dim mx As Long
Dim target As Variant 'データ型変更
'フォルダの場所を変数に入れる
Folder_path = folder
If Folder_path = "" Then Exit Sub 'フォルダダイアログでキャンセルボタンが押された
'マクロブックを開くので万が一イベントプロシジャ等があった場合に備えて
Application.EnableEvents = False
'処理中の画面の動きを隠す
Application.ScreenUpdating = False
'集計先のシートを指定し、変数に入れる
Set w = ThisWorkbook.Worksheets("集計表") 'ThisWorkbook修飾はこのマクロ自体では不要ですが、複数ブックを扱う処理なのでわかりやすくするために。
'いったん数値をクリア
w.Range("a2", "b" & Rows.Count).Clear
'集計するブックを変数に入れる
Merge_book = Dir(Folder_path & "\*.xls*")
'集計先のシートの2行からスタート
n = 2
'指定したフォルダから、Excdelファイルを探す
Do Until Merge_book = ""
Workbooks.Open Filename:=Folder_path & "\" & Merge_book
target = Empty
'ブック名の頭の文字により参照する値がかわる
If Left(Merge_book, 1) = "G" Then
target = Workbooks(Merge_book).Worksheets("費用").Range("am2").Value
Else
target = Workbooks(Merge_book).Worksheets("出力").Range("f12").Value
End If
If Not IsEmpty(target) Then '念のため、G,P以外のブックは対象外
'見つかったら、A列にファイル名、B列に集計値を入れる
w.Range("a" & n).Value = Merge_book
w.Range("b" & n).Value = target
'次の行へ
n = n + 1
End If
'集計するブックを閉じる
Workbooks(Merge_book).Close False '揮発性関数等があった場合の保存メッセージを回避。保存なしで閉じる。
'次のファイルを探しに行く
Merge_book = Dir()
Loop
'集計表シートの最終行
mx = w.Range("A" & w.Rows.Count).End(xlUp).Row
'B列,C列の最終行の下に金額の集計を入れる。
w.Range("B" & mx + 1).Formula = "=SUM(B2:B" & mx & ")"
'A列の最終行の下に集計の合計を入れる。
w.Range("A" & mx + 1).Value = "合計集計"
'イベント発生再開
Application.EnableEvents = False
End Sub
（β） 2016/04/16(土) 22:10
お忙しい所ご連絡を頂きましてありがとうございます。
先程、私の希望しているファイルを以下に添付してみました。
よろしければご覧くださいませ。
http://ww10.puny.jp/uploader/download/1460815038.zip
パスワードは、
riri
です。
添付ファイルを作っていたため、まだ教えていただいたもの試していません。。
ごめんなさい。
明日頑張りたいと思います。
りりちゃん☆彡
（りりちゃん☆彡） 2016/04/16(土) 23:02
ファイルダウンロードしました。
ところで、マクロブックも同じフォルダにあるのですか？ であれば、
Do Until Merge_book = ""
If Merge_book <> ThisWorkbook.Name Then
Workbooks.Open Filename:=Folder_path & "\" & Merge_book
'
'
'
'
'
'集計するブックを閉じる
Workbooks(Merge_book).Close False '揮発性関数等があった場合の保存メッセージを回避。保存なしで閉じる。
End If
'次のファイルを探しに行く
Merge_book = Dir()
Loop
こんなように、自分自身ならスキップするようにしてください。
それと、実際のシート名は 費用シート、出力シート なんですね。 コード内では 費用、出力 になっていますので そこも直してくださいね。
（β） 2016/04/16(土) 23:36
この度も、本当に本当にどうもありがとうございました！！！
さっきやってみたら出来たんですっ。
ありがとうございます(*´▽｀*)
（β）様のおかげで、りりが望んでいたようなことが出来たの(*'▽')
ほんとにほんとにありがとうございますっ。
できないりりちゃん☆彡の為にお時間を割いていただいたこと、色々教えていただいたこと
本当に。。感謝しても足りないくらい感謝感謝です！！
ありがとうございます(#^^#)
それにしても、、ファイルを開くときのやり方
あ〜ゆ〜やり方があるんですね。
それと、シートをPとかGとか読み込む書き方はあーゆー風にするんだ。
ありがとうございます。勉強になります。
それと開き方、あの開き方だと楽です！
やっぱり（β）さん見たく、色々知っている方だと全然違うんですね。。。
りりとの差がありすぎて、（β）さんっまぶし〜いっ☆彡
せっかくコメントアウトしていただいたんですし、りりが今回やりたかったようなことをするときは
こんな風にプログラムは作っていくんだっていう勉強もじっくりとさせていただきたいと思います。
まだまだ本当にまだまだのりりだけど、このままできるようになる日が来るのかなって
がっかりしてしまう事も多いけど。。。
でも、りり頑張るね。いつか、（β）さん見たくなれるように。。。
無理っぽい気もするけど。。でも頑張ります。
まだまだ、仕事がらみで簡単にしたいことが山ほどあって
またこのサイトでご相談させていただくかもしれません。
その時は、ご指導いただけたら嬉しいです。
本当にどうもありがとうございました。
（りりちゃん☆彡） 2016/04/17(日) 21:57
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.