[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数のファイル内にある「報告書」を一つのシート「統合シート」に、まとめたいです。』（りりちゃん☆彡）
VBA超初心者りりちゃん☆彡と申します。
複数のファイル内の、報告書に書かれている内容を「統合シート」まとめたいのですが、
上手くいかなくて困ってしまっています。
本当は同一フォルダ内にある、シートを次々呼び出して貼り付けして欲しかったのですが、超初心者のりりちゃん☆彡が本で習ったものは、同一シートの中のものを「統合シート」にまとめるやり方だったのでそれでとりあえずやってみましたが、
報告書のセルなどがロックがされているためかファイルを読み込む前に止まってしまい全然できませんでした。
やりたいことは以下となりますが、ご存知の方ご教授お願い致します。
やりたい事◆
・複数ある「報告シート」に書かれている内容を、「統合シート」にまとめたい。
・ファイルは複数ありますが、すべて同じ書式で記載されています。
・報告シート内に記載されているものは、1行のもあれば、20行のものもあります。
・本で習ったコードでは何度か試しましたが、報告書のセルなどがロックがされているためかファイルを読み込む前に止まってしまい全然できませんでした。
仕方なく、自分でシートにコピペしてやってみた所、一応統合はされました。
・報告書の元シートは、本社から配布されているシートで勝手に変えられないです。
・報告書はA～S列まで貼りつけしたいです。
Sub シート統合()
Dim i As Integer
Dim データ数 As Long
Dim 貼付先行 As Long
貼付先行 = 3
For i = 2 To Worksheets.Count
データ数 = Worksheets(i).Range("A2").CurrentRegion.Rows.Count - 1
Worksheets(i).Range("A2").Resize(データ数, 10).Copy _
Worksheets("統合").Range("A" & 貼付先行)
貼付先行 = 貼付先行 + データ数
Next
End Sub
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
おはようございます。
取り敢えずエラーの原因がシート保護だけでしたら以下で回避できます。
A列で最終行を判定していますが、A列の最終行が空白の可能性があるなら、
j = Worksheets("統合").Range("A" & Rows.Count).End(xlUp).Row + 1
の部分を、最終行に必ず値のある列に変更して下さい。
Sub シート統合()
Dim i As Integer
Dim j As Long
For i = 2 To Worksheets.Count
j = Worksheets("統合").Range("A" & Rows.Count).End(xlUp).Row + 1
If j < 3 Then j = 3
Worksheets(i).UsedRange.Offset(1).Copy Worksheets("統合").Range("A" & j)
Next
End Sub
補足です。
上記コードは、 レイアウトが分からなかったので、
＞データ数 = Worksheets(i).Range("A2").CurrentRegion.Rows.Count - 1
の部分は、1行目の見出し行を省いていると判断して、
1行目に見出し行があり、データの下の行に備考などが無い前提で書いてます。
（sy） 2016/04/21(木) 06:51
まず、やりたいことは
１．特定フォルダにあるブックを抽出（全ブックなのか、特定の名前が付いているブックなのかはわかりませんけど） ２．各ブックを開き ３．その中の "報告書" というシートの2行目から下を、マクロブック内の "統合" というシートに 上から順に貼り付けていく。
ですね。
今回アップされたコードは、マクロブック内の2番目のシートから最後のシートまでを、"統合"というシート（たぶん、最初のシート？）に 順番に貼り付けていくコートですね。
１．と２．については、
[[20160414204900]] 『VBAを使用し、異なる「報告書」データーの合計金梶x（りりちゃん☆彡）
ここでアップしたコードが参考になると思います。
で、アップされたコードだけを見ると、コピー元のシートにロックがかかっているという理由で止まってしまうところは 見当たりません。
"統合" シートが保護されていれば別ですが。
実際に止まってしまうコードはどれで、その時のエラーの番号とメッセージは、どんなものでしたか？
（β） 2016/04/21(木) 08:33
＞本当は同一フォルダ内にある、シートを次々呼び出して貼り付けして欲しかったのですが すいません。 見落としてました。 ファイル内のブック取得はβさんから提示があったのでそちらで取得して貰って、 コピー元の範囲取得でシート保護がかかっていたら CurrentRegionがエラーになっていると思いますので、 他の条件が満足するならコピーの部分は私のコードでも大丈夫と思います。 今日はPCさわれるのが夜になるのでコメントだけですいません。
（sy） 2016/04/21(木) 09:50
>>CurrentRegionがエラーになっていると思いますので
あぁ、そうですね。見落としていました。
（β） 2016/04/21(木) 09:55
いつもお世話になっております。
こんばんわ。VBA超初心者の、りりちゃん☆彡です。
書込みをいただきどうもありがとうございました。
早速ではございますが、今朝から一生懸命頑張ってみました。
（sy）様へ
朝のお忙しい時間帯にもかかわらず、書込み頂きありがとうございました。
教えていただいたコードでやってみました。
1枚目のシートを貼りつけはしてくれたのですが、2枚目～6枚目までも貼り付けるようどうすれば
良いのか考えましたが結局りりじゃ？？分からなくて。夜調べなきゃ(*_*;と思っているところです。。。
CurrentRegionっていうのを、End(xlUp).Row + 1っていうのにしてやってみたんですが
これだとやっぱり1枚のシートを貼ってくれただけだったんです。
りりのやり方が悪いのかな。。。色々教えてくださっているのにごめんなさい。。
（β）様へ
いつも大変お世話になっております。
この度も書込み頂きありがとうございます。
まずはご質問を頂いた件からお答致します。
1.～3.で（β）様がおっしゃっている通りです。
私が書いたコードは、本で習ったもので、シートに一度貼り付けしてやるように書いて有ったので
その通りにやってみたのです。。
所が、保護されているシートだからロックを外してくださいとかなんとか言われて
読込せずに途中で止まってしまったので、自分で各人から送られてくる、
元のシートを統合シートと同じシートに貼りつけしてみたらできました。
ファイルを読み込む方法も先日教えていただいたやり方で行ってみた所今日読込して
一枚目を張り付けることはできました。
昨日書込みした際の、りりの記載の方法が悪くてせっかくご指導いただいている皆様に
上手くお伝えできていなかったかもしれませんので、もう一度記載させていただきます。
昨日記載いたしました、書込みのブック内シート構成は
・統合シート
・報告書シート（1）
から～
・報告書シート（6）
に記載してあるものを、統合シートにA列～S列まであるデーターを順次貼り付けしてもらいたい
というのが、希望でした。
これは、本でならったままなら自分でもなんとかなるるかな？と思って。
本で教わったようにシートも6枚でやりました。本当はもっと沢山あります。
もしもこれで上手くいけばこれでしばらくしのごうと思ったんです。。（半分手動だけど(/_;)）
・・・がしかし、
本当の本当の希望は、
同一フォルダ内に入っている特定の「報告書シート」A列～S列までと明細は人によっていろいろ
のものを「統合シートに」自動で貼りつけてもらいたい。
というのが希望です。
先日（β）様に教えていただいたものとかで何とかならないかなとも思ってやってみたり、
本のやつで色々やったりしては見ましたが、希望にはなかなか近づかなくて。。
せっかくコードに分かりやすく書いてくれたのに。ダメダメのりりのせいですみません。
結局IF～って言うのを、りりが理解できていないからダメなのかな。
どこをどんな風にすればいいのかなと考えてはみても、
結局コードを書くってなると？？わからないんです（涙）
すみません。。
（りりちゃん☆彡） 2016/04/21(木) 21:57
こんばんわ。
βさんの ＞３．その中の "報告書" というシートの2行目から下を、マクロブック内の "統合" というシートに 上から順に貼り付けていく。
この部分だけを前回のβさんのコードから変更したいと言う事ですね。 一度ご自身で1シート分だけ貼り付け出来たと言うコードをアップされてはいかがでしょうか。
For i = 2 To Worksheets.Count
データ数 = Worksheets(i).Range("A2").CurrentRegion.Rows.Count - 1
Worksheets(i).Range("A2").Resize(データ数, 10).Copy _
Worksheets("統合").Range("A" & 貼付先行)
貼付先行 = 貼付先行 + データ数
Next
これは1つのブック内にある複数のシートのデータを貼り付けるコードなので目的とはかなり違いますね。
＞CurrentRegionっていうのを、End(xlUp).Row + 1っていうのにしてやってみたんですが
このアプローチ自体は悪くないですよ。 報告書シートが開いたブック内に1つしか無いので1つだけコピーされたと言う事ですね。
βさんのコードの、
'指定したフォルダから、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
Do ～ Loopまでがブックを開くループ処理になります。 この中の、
'見つかったら、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
この部分を今回の目的である、 ＞３．その中の "報告書" というシートの2行目から下を、マクロブック内の "統合" というシートに 上から順に貼り付けていく。 に書き換える必要があります。
今回はコピー元の範囲が可変なので、統合シートの最終行は都度 End(xlUp)などで取得する方が良いと思います。
書き換える貼り付けの部分は、
Workbooks(Merge_book).Worksheets("報告書シート").UsedRange.Offset(1).Copy w.Range("A" & Rows.Count).End(xlUP).Offset(1)
とするか、Dim x As WorkSheet で変数宣言しておいて報告書シートを毎回変数に代入して、
Set x = Workbooks(Merge_book).Worksheets("報告書シート")
x.Range("S2", x.Range("A" & Rows.Count).End(xlUp).Offset(1)).Copy w.Range("A" & Rows.Count).End(xlUp).Offset(1)
などに変更すれば良いと思います。
（sy） 2016/04/21(木) 22:50
それでは前スレのコードを踏まえて、今回の要件にしたものを一例として。 前スレと同じく、最初にフォルダ選択ダイアログをだしています。
なお、明日、お昼前から5日間ほど、旅にでます。その間、掲示板対応ができません。 （もしなにかあれば、きっと syさんが対応してくださると期待しています）
Sub シート統合2()
Dim shT As Worksheet
Dim shF As Worksheet
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 shT = ThisWorkbook.Worksheets("統合") 'ThisWorkbook修飾はこのマクロ自体では不要ですが、複数ブックを扱う処理なのでわかりやすくするために。
shT.Range("A1", shT.UsedRange).Offset(1).ClearContents '統合シートの2行目移行をクリア
'統合するブックをフォルダから取得し変数に入れる
Merge_book = Dir(Folder_path & "\*.xls*")
'指定したフォルダから、Excdelファイルを探す
Do Until Merge_book = ""
If Merge_book <> ThisWorkbook.Name Then '自分自身なら処理しない
'抽出されたブックを読みこみ、その中の報告書シートを変数shFにいれる
Set shF = Workbooks.Open(Filename:=Folder_path & "\" & Merge_book).Sheets("報告書")
'統合シートのデータ最終行の次の行番号
mx = shT.Range("A1", shT.UsedRange).Rows.Count + 1
'報告書シーから統合シートにコピペ
shF.Range("A1", shF.UsedRange).Offset(1).Copy shT.Range("A" & mx)
'開いたブックを閉じる
shF.Parent.Close False '揮発性関数等があった場合の保存メッセージを回避。保存なしで閉じる。
End If
'次のファイルを探しに行く
Merge_book = Dir()
Loop
'イベント発生再開
Application.EnableEvents = False
End Sub
Private Function folder() As String '統合したいファイルがあるフォルダを指定
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
folder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Function
（β） 2016/04/21(木) 23:17
To βさん
もう完璧な答えを提示されたので、何もなさそうですけど お気をつけて行って来て下さい。
（sy） 2016/04/21(木) 23:26
色々と教えてくださりありがとうございました。
（sy）様、
教えてくださった所やってみたのですが。。。
りりの感が悪いせいかもしれません。。。
ごめんなさい。
（β）様
色々とお世話になっております。
どうぞお気を付けて行って来て下さいっ。
先程、私が希望してたファイルと本で習ったコードを以下にupしてみました。
よろしければご覧くださいませ。
http://ww10.puny.jp/uploader/download/1461330155.zip
パスワードは、
riri
です。
今日は、なんだか風邪をまたひいてしまったようで頭が痛いです(/_;)
ご飯を食べすぎてしまったのか何なのか気持ち悪いし。。
また明日頑張ります。。
（りりちゃん☆彡） 2016/04/22(金) 22:07
こんばんわ。
ダウンロードしましたので、リンクを削除して下さい。 お大事に、ゆっくり休んで風邪治して下さい。 気付いた点などを書き込んでおきます。
少しイメージと違いました。 コピーするのは見出しも含めてなんですか？
統合シート
|[A]|[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J]
[3] | |日付 |社員コード|名前 |担当|(枚)|(時間1)|(時間2)|(時間3)|(枚2）
[4] | 1|4月1日|A101-01 |うさぎ|○田| | 0.75| 0.75| |
[5] | 2|4月1日|B102-1 |かめ |×川| | 1| 1.75| 0.25| 3
[6] | 3|4月5日|A101-02 |りす |▽木| | 0.25| 1.25| |
[7] | 4|4月5日|B102-2 |ねこ |○田| 10| | | 0.25| 1
[8] | 5|4月5日|A101-03 |いぬ |×川| | 1.5| 1.75| |
[9] | |日付 |社員コード|名前 |担当|(枚)|(時間1)|(時間2)|(時間3)|(枚2）
[10]| 1|4月1日|A101-01 |うさぎ|○田| | 0.75| 0.75| |
[11]| 2|4月1日|B102-1 |かめ |×川| | 1| 1.75| 0.25| 3
[12]| 3|4月5日|A101-02 |りす |▽木| | 0.25| 1.25| |
[13]| 4|4月5日|B102-2 |ねこ |○田| 10| | | 0.25| 1
でも初めのコードの
データ数 = Worksheets(i).Range("A2").CurrentRegion.Rows.Count - 1
これだと上下を見比べてみて分かる通り、1行データが不足していますね。
報告シート
|[A]|[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L]
[2]| |日付 |社員コード|名前 |担当|(枚)|(時間1)|(時間2)|(時間3)|(枚2）|小計 |指導料
[3]| 1|4月1日|A101-01 |うさぎ|○田| | 0.75| 0.75| | |21000| 3750
[4]| 2|4月1日|B102-1 |かめ |×川| | 1| 1.75| 0.25| 3|14000| 8750
[5]| 3|4月5日|A101-02 |りす |▽木| | 0.25| 1.25| | | 3000| 6250
[6]| 4|4月5日|B102-2 |ねこ |○田| 10| | | 0.25| 1| | 5500
[7]| 5|4月5日|A101-03 |いぬ |×川| | 1.5| 1.75| | |42000| 8750
[8]| 6|4月5日|B102-3 |とり |▽木| | 1.25| 0.5| | | 7500| 2500
私のイメージでは、見出しが統合シートの2行目にあり、その下に報告シートの1行目が見出しで2行目以降のデータのみを続けて貼り付けていくと思ってました。 おそらくβさんも、コードを見る限り、1行目に見出しで2行目以降のデータのみ貼付けをイメージしていたと思います。
実際は、1、2、どちらでしょうか？ 1、見出しも含めてコピーする。 2、見出しは含めずにデータのみコピーする。
1、でしたら、βさんが最後に提示されたコードで、そのままりりちゃん☆彡さんがやりたい事を、ほぼ100％満たしています。 (レイアウトがイメージと違ってたのが幸いですね)
2ヶ所だけ修正しないといけません。
1ヶ所目、シート名が報告書になっているので、報告に書き換えるのと、
2ヶ所目、元シートに書式のみの行があるので、貼付先の最終行の取得を、
mx = shT.Range("A" & Rows.Count).End(xlUp).Row + 1
If mx < 3 Then mx = 3
に変更して下さい。
2、でしたら、1、の修正に加えて、
'報告書シーから統合シートにコピペ
shF.Range("A1", shF.UsedRange).Offset(1).Copy shT.Range("A" & mx)
部分の"A1"を"A2"に変更すれば、データのみコピーされます。
（sy） 2016/04/22(金) 23:33
βさんのコードで1のパターンの修正したコードを記載しておきます。 そのまま統合シートの標準モジュールに貼り付ければ使用出来ます。
Sub シート統合2()
Dim shT As Worksheet
Dim shF As Worksheet
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 shT = ThisWorkbook.Worksheets("統合") 'ThisWorkbook修飾はこのマクロ自体では不要ですが、複数ブックを扱う処理なのでわかりやすくするために。
shT.Range("A1", shT.UsedRange).Offset(2).ClearContents '統合シートの3行目移行をクリア
'統合するブックをフォルダから取得し変数に入れる
Merge_book = Dir(Folder_path & "\*.xls*")
'指定したフォルダから、Excdelファイルを探す
Do Until Merge_book = ""
If Merge_book <> ThisWorkbook.Name Then '自分自身なら処理しない
'抽出されたブックを読みこみ、その中の報告書シートを変数shFにいれる
Set shF = Workbooks.Open(Filename:=Folder_path & "\" & Merge_book).Sheets("報告")
'統合シートのデータ最終行の次の行番号
mx = shT.Range("A" & Rows.Count).End(xlUp).Row + 1
If mx < 3 Then mx = 3
'報告書シーから統合シートにコピペ
shF.Range("A1", shF.UsedRange).Offset(1).Copy shT.Range("A" & mx)
'開いたブックを閉じる
shF.Parent.Close False '揮発性関数等があった場合の保存メッセージを回避。保存なしで閉じる。
End If
'次のファイルを探しに行く
Merge_book = Dir()
Loop
'イベント発生再開
Application.EnableEvents = True
End Sub
Private Function folder() As String '統合したいファイルがあるフォルダを指定
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
folder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Function
To βさん
βさんのコードで最後まで話を進めさせて頂きます。
追加修正で、統合シートは2行目以降がクリアされるようになってたので、3行目以降をクリアに修正しました。
（sy） 2016/04/22(金) 23:46
今後の為に、VBEの[ツール]→[オプション]を開いて、[編集]タブの[変数の宣言を強制する(R)]にチェックを入れておきましょう。 チェックを入れると、今後のマクロを作成する時にコードウィンドウの先頭行に Option Explicit が記述されます。 これは変数を入力する時に必ず宣言しなければEXCELから叱られるようになります。 そうする事で変数間違いを防げるようになります。
後コードを分解して、それぞれの意味を理解すれば、今後に役立つと思います。 それぞれの部分で意味の分からない部分があれば質問して下さい。 1つ1つ理解していけば、部分的に修正して応用する事が可能になります。 簡単に分解しておきます。
変数宣言
Sub シート統合2()
Dim shT As Worksheet
Dim shF As Worksheet
Dim Merge_book As String
Dim Folder_path As String
Dim mx As Long
'
'
'
'
'
フォルダ選択
'フォルダの場所を変数に入れる
Folder_path = folder
If Folder_path = "" Then Exit Sub 'フォルダダイアログでキャンセルボタンが押された
Private Function folder() As String '統合したいファイルがあるフォルダを指定
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
folder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Function ' ' ' ' ' 画面更新抑制、イベント抑制
'もし、開くブックがマクロブックだった場合、万が一イベントプロシジャ等があった場合に備えて
Application.EnableEvents = False
'処理中の画面の動きを隠す
Application.ScreenUpdating = False
'
'
'
'
'
統合シートを変数に格納
'集計先のシートを指定し、変数に入れる
Set shT = ThisWorkbook.Worksheets("統合") 'ThisWorkbook修飾はこのマクロ自体では不要ですが、複数ブックを扱う処理なのでわかりやすくするために。
'
'
'
'
'
統合シートの初期化
shT.Range("A1", shT.UsedRange).Offset(2).ClearContents '統合シートの3行目移行をクリア
'
'
'
'
'
フォルダ内の1つ目の報告シートのブック名を変数に格納
'統合するブックをフォルダから取得し変数に入れる
Merge_book = Dir(Folder_path & "\*.xls*")
'
'
'
'
'
報告シートのブックを次々に探して開いて(開く時に報告シートを変数に格納)閉じるループ
'指定したフォルダから、Excelファイルを探す
Do Until Merge_book = ""
If Merge_book <> ThisWorkbook.Name Then '自分自身なら処理しない
'抽出されたブックを読みこみ、その中の報告書シートを変数shFにいれる
Set shF = Workbooks.Open(Filename:=Folder_path & "\" & Merge_book).Sheets("報告")
～ここに目的の処理を記述～
'開いたブックを閉じる
shF.Parent.Close False '揮発性関数等があった場合の保存メッセージを回避。保存なしで閉じる。
End If
'次のファイルを探しに行く
Merge_book = Dir()
Loop
'
'
'
'
'
今回の目的の報告シートの内容を統合シートにコピペ
上のループ内の～ここに目的の処理を記述～の部分に記述
(ここを変更すれば開いたブックに対して違う処理が可能になります)
'統合シートのデータ最終行の次の行番号
mx = shT.Range("A" & Rows.Count).End(xlUp).Row + 1
If mx < 3 Then mx = 3
'報告書シーから統合シートにコピペ
shF.Range("A1", shF.UsedRange).Offset(1).Copy shT.Range("A" & mx)
'
'
'
'
'
イベントの抑制は最後戻さないといけない
'イベント発生再開
Application.EnableEvents = True
End Sub
（sy） 2016/04/23(土) 09:04
こんばんわ。りりちゃん☆彡です。
お忙しい中、２回も書きこみしてくださっていたんですね。
ありがとうございます｡.(✿╹◡╹)ﾉ☆
風邪をひいてしまった為、夕べは早く寝てしまったりりなのに、
解説書いて下さったり、丁寧にアドバイスを下さったり、教えてくださったり、
本当に本当にどうもありがとうございますｏ(*'▽'*)/☆゜'・:*☆ありがとにゃ☆
解説頂いたのすごく分かりやすいです！！
～ここに目的の処理を記述～
ってなって居るところに、やりたいことを書きこみするって事ですよね。
で、今回の事でいうと、
'統合シートのデータ最終行の次の行番号
mx = shT.Range("A" & Rows.Count).End(xlUp).Row + 1
If mx < 3 Then mx = 3
'報告書シーから統合シートにコピペ
shF.Range("A1", shF.UsedRange).Offset(1).Copy shT.Range("A" & mx)
'
ここの部分を入れているのが、やりたいことにあたるって事ですね♪
そうっか～ここだったんだ～ぁ。
よーく分かりましたっ。。（って今だけかもしれない怪しいりりだけど。。）
でも、VBAを作りこむときは、こういう風に作っていくっていうか書きこんでいくんだっていうの
は良く分かった気がするの。（りりが今後作れるかどうかはまたまた怪しいけど。。(..)）
でも、りりもっと簡単なやつなら作れるようになりたいの！だから頑張るね。
とっ所でなんですが、、、
一枚だけじゃなくて、同じ形式で書かれているシートを繰り返して下のやつ見たく貼り付けしてくれるよう
エクセルに頼む場合はどういう風に書けばなるんでしょうか？？？
もしもよろしければ教えてほしいです(*^▽^*)
イメージ的には、、（sy）さんが書いてくれた以下のような感じに
別シートも読み込んで次から次から貼ってもらえるようにしたいです☆彡
|[A]|[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J] [3] | |日付 |社員コード|名前 |担当|(枚)|(時間1)|(時間2)|(時間3)|(枚2） [4] | 1|4月1日|A101-01 |うさぎ|○田| | 0.75| 0.75| | [5] | 2|4月1日|B102-1 |かめ |×川| | 1| 1.75| 0.25| 3 [6] | 3|4月5日|A101-02 |りす |▽木| | 0.25| 1.25| | [7] | 4|4月5日|B102-2 |ねこ |○田| 10| | | 0.25| 1 [8] | 5|4月5日|A101-03 |いぬ |×川| | 1.5| 1.75| | [9] | |日付 |社員コード|名前 |担当|(枚)|(時間1)|(時間2)|(時間3)|(枚2） [10]| 1|4月1日|A101-01 |うさぎ|○田| | 0.75| 0.75| | [11]| 2|4月1日|B102-1 |かめ |×川| | 1| 1.75| 0.25| 3 [12]| 3|4月5日|A101-02 |りす |▽木| | 0.25| 1.25| | [13]| 4|4月5日|B102-2 |ねこ |○田| 10| | | 0.25| 1
最終的に、人ごとに集計を出して上司に提出しなければならないんです。。
今は手作業で頑張っていますが、できれば取りこみしてしてもらったらこの上の表見たく
報告書シートに記載がある部分だけを貼ってもらいたいな。って思ってました。
これを[9] | |日付 |社員コード|名前 |担当|(枚)|(時間1)|(時間2)|(時間3)|(枚2）
この欄だけ抜いて（どの人の報告書シートか分からなくなっちゃうと確認に時間がかかると大変なので）
後で空白列ファイル名を入れるようにすれば確認の時楽かなって思っています。
このシートが完成すれば集計の時間に今の時間の約半分くらいでおわすことができるかな。
って思っているんです(^^♪
それにしても先生二人に教えていただけるなんて、本当に助かるなぁ。
本当にどうも、ありがとうねo(*^▽^*)o
できないりりなのに、頼もしい （sy） さんのおかげで、
また少し前進できちゃったかもっ♪るんっ♪
今後ともご指導いただけますよう、どうぞよろしくお願い致します。
（りりちゃん☆彡） 2016/04/23(土) 22:41
こんばんわ。
今回忘れたとしても、コードを分解して意味を理解する事を繰り返していくうちに、 自然と身に付いてると思いますので、頑張って下さい。
ただ、、、要件については、私も分からなくなってきました？
＞一枚だけじゃなくて、同じ形式で書かれているシートを繰り返して下のやつ見たく貼り付けしてくれるよう ＞エクセルに頼む場合はどういう風に書けばなるんでしょうか？？？
ちょっと、この部分がよく分からないですねぇ？ ダウンロードしたフォルダの中の各個人の報告用ブックには、報告シートが1つづつしか無かったんですが、 実際の報告用ブックの中には複数の報告シートがあるのでしょうか？
アップされたコードは、ダウンロードしたフォルダ内に存在する[H報告書【名前】.xlsm]と言うブックの、 報告シートのデータを次々読み込んで、見出し毎データを貼り付けます。 (コピーされたブックも対象に合計7個のブックを読み込んでます) (統合用のブックの、2つ目以降のシートのデータは読み込んでいませんよ)
もう一度やりたい事の確認ですが、 1、同じフォルダ内にある各個人用の報告用ブックを開く 2、報告用ブックの中の報告シートのデータを、見出しも含めて統合シートに上から順に貼り付ける 3、フォルダ内のブック全てで上記を繰り返し
1、に関しては問題ないと思いますが、 2、の部分が報告シートは1シートと思ってましたが、実際は複数あると言う事ですか？
後、ファイル名も取得して表記したいと言う事なので、A列の日付の横の空欄にファイル名が書き込まれれば良いですか？
シートを複数と言われているのが、今一よく分かってないですが、下のコードでは要件に合ってますか？ 開いたブックの全てのシートを読み込むようにして、A列の見出し部分にブック名とシート名を表示させるようにしました。
Sub シート統合3()
Dim shT As Worksheet
Dim shF As Worksheet
Dim Merge_book As String
Dim Folder_path As String
Dim mx As Long
Dim bkF As Workbook
Dim i As Integer
'フォルダの場所を変数に入れる
Folder_path = folder
If Folder_path = "" Then Exit Sub 'フォルダダイアログでキャンセルボタンが押された
'もし、開くブックがマクロブックだった場合、万が一イベントプロシジャ等があった場合に備えて
Application.EnableEvents = False
'処理中の画面の動きを隠す
Application.ScreenUpdating = False
'集計先のシートを指定し、変数に入れる
Set shT = ThisWorkbook.Worksheets("統合") 'ThisWorkbook修飾はこのマクロ自体では不要ですが、複数ブックを扱う処理なのでわかりやすくするために。
shT.Range("A1", shT.UsedRange).Offset(2).ClearContents '統合シートの3行目移行をクリア
'統合するブックをフォルダから取得し変数に入れる
Merge_book = Dir(Folder_path & "\*.xls*")
'指定したフォルダから、Excelファイルを探す
Do Until Merge_book = ""
If Merge_book <> ThisWorkbook.Name Then '自分自身なら処理しない
'抽出されたブックを読みこみ、変数bkFにいれる
Set bkF = Workbooks.Open(Filename:=Folder_path & "\" & Merge_book)
'ブック中のシートを全て読み込む
For i = 1 To bkF.Sheets.Count
'シートを変数に入れる
Set shF = bkF.Sheets(i)
'統合シートのデータ最終行の次の行番号
mx = shT.Range("A" & Rows.Count).End(xlUp).Row + 1
If mx < 3 Then mx = 3
'報告シートから統合シートにコピペ
shF.Range("A1", shF.UsedRange).Offset(1).Copy shT.Range("A" & mx)
shT.Range("A" & mx).Value = "ブック名： " & Left(Merge_book, InStrRev(Merge_book, ".") - 1) & vbLf & "シート名： " & shF.Name
Next i
'開いたブックを閉じる
shF.Parent.Close False '揮発性関数等があった場合の保存メッセージを回避。保存なしで閉じる。
End If
'次のファイルを探しに行く
Merge_book = Dir()
Loop
'イベント発生再開
Application.EnableEvents = True
End Sub
Private Function folder() As String '統合したいファイルがあるフォルダを指定
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
folder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Function
（sy） 2016/04/24(日) 02:28
おはようございます。
もしかしたら、言葉の行き違いがあるんじゃないかと。 シートとブックを間違えていませんか？
ダウンロードしたフォルダを開いて表示されるファイル、[シート統合希望.xlsm]や[H報告書【名前】.xlsm] これらはワークブックもしくはブックと呼びます。(ファイルでも良いです)
そして、このブックを開いて表示されるものがワークシートもしくはシートと呼びます。 [H報告書【名前】.xlsm]ブックの中には、[報告]シートが1シートだけあります。 [シート統合希望.xlsm]ブックの中には、[統合][報告][報告(8)][報告(2)][報告(3)][報告(4)][報告(5)][報告(6)]の8シートがあります。
コードは[シート統合希望.xlsm]ブックの中の[報告...]の8シートは読み込んでいません。 フォルダ内にある、[H報告書【名前】.xlsm]ブックの[報告]シートを順番に読み込んでいます。 (フォルダ内の[H報告書【名前】コピー....xlsm]の7つのブックを全て順番に読み込んでます) 今日アップしたコードでは、フォルダ内にある、[H報告書【名前】....xlsm]の7つのブック内にある全てのシートを読み込むようになっています。
[シート統合希望.xlsm]ブック内の[報告..]シートは、手作業で[H報告書【名前】....xlsm]ブックからシートをコピーされているんですね？ その作業は必要ありません。 もしくはシート自体もコピーしたいのなら、コードの修正が必要ですが。。。
（sy） 2016/04/24(日) 09:56
こんばんわっ。りりちゃん☆彡です。
ありがと～～！超りりの希望どおりになってるのっ。
スゴイねスゴイね。（sy）さんってスゴイね(*^ーﾟ)b
チョー尊敬～(*'▽')
本当にどうもありがとうございましたっ。
りり、この仕事に結構時間取られてて大変だったの。。。
でも明日からは、（sy）さんのおかげでちょっと楽になると思うのｏ(*'▽'*)/☆
ﾟ･:,｡★＼(^-^ )♪ありがと♪( ^-^)/★,｡･
それにしても、、本当に本当にお忙しい中私の為に時間をさいて頂いたり、ご指導を頂いたり
ありがとうございました。色々とお世話になりましたっ。
ﾄﾞｷ!（'O'（ｰ^*）chu♪
まだまだ超初心者のりりだけど、まだまだ沢山ある簡単にしたいことを頑張るために
これからも勉強を続けていきたいと思いますっ。
それと。。今回書いていただいたコードで聞きたいことがあったらまた質問させていただいていいですか？？
もしもおいそがしかったらいいんですけど。。
あと。。ブックとシートの件。。
全部シートって言ってます！ゴメンナサイ。。本で習ったけど忘れましたっ(..)
だって。。良く分からなかったから。。
でも（sy）さんが教えてくれたから今度は覚えられたかも・・？
ゴメンナサイ。。
最初からりりがお伝えを上手に出来なかったから余計に手間をかけさせてしまったんですね。。
（´・ω・`）ｼｮﾎﾞｰﾝ
ごめんなさい。。
でもでも～っ。次にご相談投稿する時にはっ、ちゃ～んとお伝えできるりりになりますっ。
それで許してほしいです(^^ゞ
本当に本当に、どうもありがとうございました！
☆--:*:--☆--:*:--☆--:*
まだまだ、仕事を楽にしたい部分が多々あって、
またこの学校に投稿させていただくことになると思います。
もしもまたりりを見かけた時は、これに懲りずにどうか是非是非、ご指導いただけたら嬉しいです。
本当にどうもありがとうございました。
PS.春になったとはいえ、天気のいい日と悪いの差が激しい今日この頃です。
どうか風邪など引かないようにお気を付けください。
（りりちゃん☆彡） 2016/04/24(日) 21:51
こんばんわ。
希望通りに上手くいってなによりです。
一応報告ブック中のシート自体をコピーするコードも考えたけど必要なかったですね。 せっかくなのでアップしておきます。 お暇な時にでも動作の違いを確認してみて下さい。
ただこのコードはダウンロードしたブック名ではシートの名前を付ける時にエラーになります。
H報告書【名前】.xlsm H報告書【名前】 - コピー.xlsm H報告書【名前】 - コピー (2).xlsm
【】の中の名前&シート名で新しく名前を付けるので、上記だと、全て【名前】なのでエラーになります。
H報告書【A】.xlsm H報告書【B1】.xlsm H報告書【B2】.xlsm
上のように【】内で区別されるようなブック名になっていたら、正しく実行されます。
Sub シート統合4()
Dim shT As Worksheet
Dim shF As Worksheet
Dim Merge_book As String
Dim Folder_path As String
Dim mx As Long
Dim bkF As Workbook
Dim i As Integer
'フォルダの場所を変数に入れる
Folder_path = folder
If Folder_path = "" Then Exit Sub 'フォルダダイアログでキャンセルボタンが押された
'もし、開くブックがマクロブックだった場合、万が一イベントプロシジャ等があった場合に備えて
Application.EnableEvents = False
'処理中の画面の動きを隠す
Application.ScreenUpdating = False
'警告ダイアログの非表示
Application.DisplayAlerts = False
'集計先のシートを指定し、変数に入れる
Set shT = ThisWorkbook.Worksheets("統合") 'ThisWorkbook修飾はこのマクロ自体では不要ですが、複数ブックを扱う処理なのでわかりやすくするために。
shT.Range("A1", shT.UsedRange).Offset(2).ClearContents '統合シートの3行目移行をクリア
For i = Sheets.Count To 1 Step -1
If Sheets(i).Name <> shT.Name Then
Sheets(i).Delete
End If
Next i
'統合するブックをフォルダから取得し変数に入れる
Merge_book = Dir(Folder_path & "\*.xls*")
'指定したフォルダから、Excelファイルを探す
Do Until Merge_book = ""
If Merge_book <> ThisWorkbook.Name Then '自分自身なら処理しない
'抽出されたブックを読みこみ、変数bkFにいれる
Set bkF = Workbooks.Open(Filename:=Folder_path & "\" & Merge_book)
'ブック中のシートを全て読み込む
For i = 1 To bkF.Sheets.Count
'シートを変数に入れる
Set shF = bkF.Sheets(i)
'報告ブックからシートをコピーして一番後ろに作成
shF.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'作成したシート名を報告ブックの名前&シート名に変更
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Mid(Left(Merge_book, InStr(Merge_book, "】")), InStr(Merge_book, "【")) & shF.Name
'統合シートのデータ最終行の次の行番号
mx = shT.Range("A" & Rows.Count).End(xlUp).Row + 1
If mx < 3 Then mx = 3
'報告シートから統合シートに見出しを含めてデータをコピペ
shF.Range("A1", shF.UsedRange).Offset(1).Copy shT.Range("A" & mx)
'A列見出し行にブック名とシート名を表示
shT.Range("A" & mx).Value = "ブック名： " & Left(Merge_book, InStrRev(Merge_book, ".") - 1) & vbLf & "シート名： " & shF.Name
Next i
'開いたブックを閉じる
shF.Parent.Close False '揮発性関数等があった場合の保存メッセージを回避。保存なしで閉じる。
End If
'次のファイルを探しに行く
Merge_book = Dir()
Loop
shT.Activate
'イベント発生再開
Application.EnableEvents = True
'警告ダイアログの表示
Application.DisplayAlerts = True
End Sub
Private Function folder() As String '統合したいファイルがあるフォルダを指定
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
folder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Function
（sy） 2016/04/24(日) 22:40
後分からない事があったら、またいつでも質問して頂いたら、私で分かる事でしたら全然お答えしますが、 このスレでは無く、分からない事を題材にしたスレを新たに立ち上げた方が、他の方からも意見がたくさん聞けると思いますよ。
（sy） 2016/04/24(日) 23:29
こんばんわっ。りりちゃん☆彡です。
この度は色々とお世話になっております。
今日、職場でやってみたら。。。
シートが3枚目だったことでだと思うのですが途中でとまってしまったのです。。
色々と私の方でも解読を試みましたが、、
りりちゃんの全くないっVBAスキルでは、ちょっと難しすぎて。。v(･∀･*)
すみませんが解消方法を教えていただけませんでしょうかっ！？
報告書のブック（？）構成は、
・一枚目のシートに（計算価格書）
・二枚目のシートに（報告a)
・三枚目のシートに（報告集計用）←このシートを次々貼ってもらいたいです✨
のシート構成になっています。
読み込んで、次々貼りつけてもらうためにはどの部分を修正すればよろしいでしょうか。
何度も申し訳ありませんが教えてくださいっφ(･ω･`)
（りりちゃん☆彡） 2016/04/25(月) 21:16
こんばんわ。
Sub シート統合3()のコードで途中で止まったんですか？
このコードは全てのシートを読み込むので何シート目とか関係なしに、全て読み込むんですが。 不要なシートがあったら、それも読み込まれてしまいますが。。。
エラーが出るのは、コードのどの部分でしょうか？ 後、エラーメッセージも教えて下さい。
＞・三枚目のシートに（報告集計用）←このシートを次々貼ってもらいたいです✨ 他のシートは無視して、このシートだけを読み込みたいと言う事ですか？
その場合下記の方法があります。 1、正確なシート名で読込む。 (シートの並び順は適当で良いですが、全てのブックで全く同じシート名になっていないといけません。) 2、シートの並び順(質問では左から3番目)で読込む。 (シート名は違ってても良いですが、並びは必ず左から3番目でなければいけません。) 3、シート名の一部分に各ブックで共通の文字が含まれていて、同じブックの他のシートで使われていない文字で読込む。 (文字が他で使われていれば、誤認識の原因になります。)
（sy） 2016/04/25(月) 22:01
もしかしたらですけど、
Set shT = ThisWorkbook.Worksheets("統合")
この部分で止まってませんか？
他にエラーになる部分が、ちょっと思いつかないので？？？ 上記でしたら、貼り付けるシート名が「統合」と言う名前じゃないと言う事になります。 正確なシート名に変更して下さい。
（sy） 2016/04/25(月) 22:18
こんばんわっ。りりちゃん☆彡です。
いつもお世話になっております(#^^#)
今日、もう一回やってみたら、
shF.Range("A1", shF.UsedRange).Offset(1).Copy shT.Range("A" & mx)
って言う所で止まってしまいましたっ。
統合してほしいシートにはりりちゃんと「統合」っていれました～。
多分、シートを全部読んでしまうと、
報告ブックに書いて有る、
・一枚目のシートに（計算価格書）
このシートは読み込んでました。
・二枚目のシートに（報告a)
これが途中で引っかかった見たい(/_;)
と言う訳で、実際に読み込んでほしかった報告集計シートまではたどり着けない感じでした。。
・三枚目のシートに（報告集計用）←このシートを次々貼ってもらいたいです✨
・・・多分なのですが、報告集計シートを指定して読み込むようにすればいい気がしますが、
やり方が分からないのでお忙しい所申し訳ないのですが、アドバイスお願いしますっ。
それで、、質問のお答は以下のとおりです。
＞・三枚目のシートに（報告集計用）←このシートを次々貼ってもらいたいです✨
＞ ＞他のシートは無視して、このシートだけを読み込みたいと言う事ですか？
そうです☆彡（報告集計用）だけを、次々貼って欲しいんですっ。
ブック内のシート構成は、他のブックも同じ構成です。
この、人ごとにある、「報告ブック」なのですが、シートを削除したりって
できないんです。。
本社からの支給品でこちら側でいろいろできないようになっている見たい。
ホントだからこそめんどっくさいんだけどね。。
まあ、、仕方いないんですけどね。。
今日はりりちゃん、風邪ぶり返しちゃったみたいで、お医者さん行きました。。
風邪がなかなか治らなくてホント困っちゃう。。（涙）
夜中咳が出ちゃって眠れないんです(/_;)今日は早く休みます。。
お休みなさい(*'▽')
PS.（sy）さんも、風邪には気を付けてくださいね！！
（りりちゃん☆彡） 2016/04/26(火) 21:36
こんばんわ。
風邪ぶり返して大変ですね。 お大事にして下さい。
＞shF.Range("A1", shF.UsedRange).Offset(1).Copy shT.Range("A" & mx)
＞って言う所で止まってしまいましたっ。
データのcopyでエラーになってるんですか！？ 肝心のエラーメッセージはどのような内容だったのでしょうか？ エラーの原因が分からないと、修正コードを書いても解決しないかも知れないので、エラーメッセージを教えて下さい。
コピー元のシートが1つだけでしたら、 Sub シート統合2() の方のコードで大丈夫なんですが、 1、正確なシート名で読込む。 2、シートの並び順、左から3番目で読込む。 3、シート名の一部の共通文字で読込む。 上記のどれかになるんですが、読込むシート名が全てのブックで「報告集計用」となっていれば、1の方法が無難です。 (「報告集計用(1)」のように(1)とかの余計な文字があっては駄目ですよ。)
Sub シート統合2()のコードの、下のループ部分の Sheets("報告") を、
1、の場合は Sheets("報告集計用") に変える。
2、の場合は Sheets(3) に変える。
1、2、どちらも使えない場合は3、になりますが、まずは1、2、どちらかで試して下さい。
'指定したフォルダから、Excdelファイルを探す
Do Until Merge_book = ""
If Merge_book <> ThisWorkbook.Name Then '自分自身なら処理しない
'抽出されたブックを読みこみ、その中の報告書シートを変数shFにいれる
Set shF = Workbooks.Open(Filename:=Folder_path & "\" & Merge_book).Sheets("報告")
'統合シートのデータ最終行の次の行番号
mx = shT.Range("A" & Rows.Count).End(xlUp).Row + 1
If mx < 3 Then mx = 3
'報告書シーから統合シートにコピペ
shF.Range("A1", shF.UsedRange).Offset(1).Copy shT.Range("A" & mx)
'開いたブックを閉じる
shF.Parent.Close False '揮発性関数等があった場合の保存メッセージを回避。保存なしで閉じる。
End If
'次のファイルを探しに行く
Merge_book = Dir()
Loop
でもcopyの部分でエラーになってるんでしたら、解決しないかも知れません。
エラーメッセージが分からないと私も何も分からないので、次もエラーになるようでしたら控えて置いて下さい。
（sy） 2016/04/26(火) 22:12
旅から戻りました。
sy さん、フォローありがとうございました。 ここまで、対応していただいていますので、このあと、もう一頑張りも、syさんにお任せしたいと思います。 よろしくお願いします。
（β） 2016/04/27(水) 06:44
To βさん
おかえりなさい。
留守中に簡単に解決するだろうと思ってたら、結構難儀な事になりました。 エラーメッセージさえ分かれば何とかなりそうだけど、返事待ちですね。
（sy） 2016/04/27(水) 23:35
こちらは後一息って感じですけど、今どうなってるんでしょうか？
上手くいったのなら何よりですけど、 まだエラーが出るようでしたら、一度下記コードをエラーが出る行より一行上に追記して、メッセージを確認してみて下さい。
MsgBox shF.UsedRange.Address
（sy ） 2016/05/04(水) 16:34
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.