4年に一度のスポーツの祭典 全競技速報中

毎月100か所ほどから、添付した報告様式(エクセル形式)により
報告が届いて、そのファイルを一つ一つ開いて、まとめ用ファイル
(1つのファイルに項目ごとのシートを設定)にコピーする作業を
しています。
あくまでコピーですので、数字などの集計はしていません。

単純作業ですが、非常に手間がかかっており、技術的に可能なのか
わからないのですが、例えば
   指定されたフォルダにその100の報告ファイルを収納
すれば、エクセル形式の一覧で表示されれば、非常に手間が省ける
ので、もしその方法(VBA?マクロ?)があればご教示をお願い
します。

なお、各支所(仮)が入力する様式と一括表示するフォームのイメ
ージを作成し添付しております。
集約や表示には関係ないと思いますが、報告様式の赤字はドロップ
ダウンリストで入力するようになっております。

一括表示するフォームはあくまでイメージです。
各項目ごとに都合上、内容欄の数が違っていますが、一括表示時に
は、左詰めで表示ができれば便利ですが、できなくても大丈夫です。

素人の厚かましいお願い(質問)となりますので、質問自体の意味
や表現がおかしいところがあると思いますが、何卒お許しください。

どうぞ、よろしくお願いいたします。

「複数の報告様式における記載事項を一括表示」の質問画像

質問者からの補足コメント

  • 一括集約のイメージとなります。
    なお、上の報告様式の黄色のセルが
    各支所(仮名)の入力箇所となります。

    「複数の報告様式における記載事項を一括表示」の補足画像1
      補足日時:2021/03/18 17:38
  • tatsumaru77様

    ご質問ありがとうございます。
    回答が遅くなり申し訳ありません。
    下記の通り(→)回答致します。
    どうぞ宜しくお願いします。

    1.→その通りです

    2. →"sheet1"となります

    3.→その通りです。

    3-2.→報告書のレイアウトは全て同じです
    このレイアウトで送って来ます。
    ただし最下段のサヌルケミの欄は行数を増やして来る場合がありますが制限を掛けることはできます

    4.→一括表示でお願い致します。

    5.→その通りです。

      補足日時:2021/03/19 22:55
  • tastumaru77様
    色々お手数をお掛け致します
    エラー箇所と収納フォルダの写真
    を添付致します
    エラー箇所はデバックを表示すると
    黄色の箇所が表示されます
    ご確認いただければありがたいです。

    「複数の報告様式における記載事項を一括表示」の補足画像3
      補足日時:2021/03/20 12:16
  • 収納フォルダ

    「複数の報告様式における記載事項を一括表示」の補足画像4
      補足日時:2021/03/20 12:16
  • tastumaru77様

    ご指摘の通り
    修正などしましたら
    無事プログラムが動きました
    素晴らしいです
    tastumaru様の力量に驚くばかりです

    最後こちらで作った報告様式に
    1部抜けがあり
    添付写真の通りなのですが
    項目オの26からB28を結合させた
    セルに数字(右の肌色セルを足した
    数字が入っている)が入っており
    このオと緑色のセルの数字(24)
    だけを拾って
    一括表示の中(間)に入れたいのですが
    可能でしょうか
    難しい作業となれば諦めますので
    無理はないようにお願い致します。

    どうぞ宜しくお願いします。

    「複数の報告様式における記載事項を一括表示」の補足画像5
      補足日時:2021/03/20 12:47
  • tastumaru77 様

    度々申し訳ありません。
    一括表示結果は
    添付のイメージになればありがたいです。
    大変お手数をお掛け致します

    「複数の報告様式における記載事項を一括表示」の補足画像6
      補足日時:2021/03/20 13:18
gooドクター

A 回答 (10件)

前回のは破棄してください。


以下のマクロを標準モジュールに登録してください。
Option Explicit
Public Sub 一括表示()
Dim ms As Worksheet '一活表示用シート
Dim maxrow As Long '一活表示用最大行番号
Dim mrow As Long '一活表示用行番号
Dim bookName As String
Application.ScreenUpdating = False
Set ms = Worksheets("一括表示")
maxrow = ms.Cells(Rows.Count, "A").End(xlUp).row
If maxrow > 1 Then
ms.Range("A2:G" & maxrow).Value = ""
End If
bookName = Dir(ThisWorkbook.Path & "\*.xlsx")
mrow = 1
Do While bookName <> ""
Call Read1Book(bookName, ms, mrow)
bookName = Dir()
Loop
Application.ScreenUpdating = True
MsgBox ("完了")
End Sub
Public Sub Read1Book(ByVal bookName As String, ByVal ms As Worksheet, ByRef mrow As Long)
Dim wb As Workbook
Dim ws As Worksheet '支所のシート
Dim maxrow As Long
Dim wrow As Long
Dim mcol As Long
Dim wcol As Long
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & bookName)
Set ws = wb.Worksheets("Sheet1")
maxrow = ws.Cells(Rows.Count, "A").End(xlUp).row
If maxrow < 33 Then
maxrow = 33
End If
For wrow = 5 To 24
mrow = mrow + 1
ms.Cells(mrow, "A").Value = ws.Cells(2, "C").Value '支所
ms.Cells(mrow, "B").Value = ws.Cells(wrow, "A").MergeArea(1).Value '項目
ms.Cells(mrow, "C").Value = ws.Cells(wrow, "B").Value '回数
ms.Cells(mrow, "D").Value = ws.Cells(wrow, "C").Value '人数
ms.Cells(mrow, "E").Value = ws.Cells(wrow, "D").Value '内容1
mcol = 5
For wcol = 5 To 7
If ws.Cells(wrow, wcol).MergeArea(1).Address <> ws.Cells(wrow, wcol - 1).MergeArea(1).Address Then
mcol = mcol + 1
ms.Cells(mrow, mcol).Value = ws.Cells(wrow, wcol).Value '内容2,3
End If
Next
Next
wrow = 25
mrow = mrow + 1
ms.Cells(mrow, "A").Value = ws.Cells(2, "C").Value '支所
ms.Cells(mrow, "B").Value = ws.Cells(wrow, "A").MergeArea(1).Value '項目
ms.Cells(mrow, "C").Value = ws.Cells(wrow + 1, "B").Value '回数
For wrow = 29 To maxrow
mrow = mrow + 1
ms.Cells(mrow, "A").Value = ws.Cells(2, "C").Value '支所
ms.Cells(mrow, "B").Value = ws.Cells(wrow, "A").MergeArea(1).Value '項目
ms.Cells(mrow, "C").Value = ws.Cells(wrow, "B").Value '回数
ms.Cells(mrow, "D").Value = ws.Cells(wrow, "C").Value '人数
ms.Cells(mrow, "E").Value = ws.Cells(wrow, "D").Value '内容1
mcol = 5
For wcol = 5 To 7
If ws.Cells(wrow, wcol).MergeArea(1).Address <> ws.Cells(wrow, wcol - 1).MergeArea(1).Address Then
mcol = mcol + 1
ms.Cells(mrow, mcol).Value = ws.Cells(wrow, wcol).Value '内容2,3
End If
Next
Next
wb.Close

End Sub
    • good
    • 0
この回答へのお礼

tastumaru77様
この度はありがとうございました。
無理な変更にもご丁寧に対応いただき
大変感謝しております。
このようなスキルを早く少しでも
身につけて作業の効率化を図って
行きたいと思います。
この度は本当にありがとうございました。

お礼日時:2021/03/20 14:28

>項目オの26からB28を結合させた


>セルに数字(右の肌色セルを足した
>数字が入っている)が入っており
>このオと緑色のセルの数字(24)
>だけを拾って
>一括表示の中(間)に入れたいのですが
>可能でしょうか

一括表示シートへの出力結果は、どのようになりますか。
25,26,27,28の4行分の出力なのか、
1行分の出力なのかが、よくわかりません。
画像を提示していただけませんでしょうか。

又、かなりイレギュラーな処理になるので、
25行から28行限定での処理になると思います、
    • good
    • 0

あなたが提示されたファイルの画像は、拡張子が表示されていません。


念のため、下記URLを参考にして、拡張子を表示して、拡張子の確認をしていただけませんでしょうか。
https://www.pc-koubou.jp/magazine/36291

A支店.xlsx
集約用プログラム.xlsm
のように表示されればOKです。
    • good
    • 0

追伸


集約用プログラムに”一括表示”シートがあって、エラーが起こる場合、
シート名の前後に空白がないか確認してください。
空白があると、正しくシート名を認識できません。
    • good
    • 0

1.集約用プログラムにマクロは格納されていますか。


2.集約用プログラムに”一括表示”シートはありますか。

添付図のエラーは、”一括表示”シートがない場合に、発生します。
    • good
    • 0

>sheet1に支店からの報告様式を入れて


>sheet2に集約させるために
>マクロを走らせたのですが
>実行時エラー"9"
>インデックスが有効範囲にありません
>と表示されるのですが

①各支店からのファイル(ブック)のSheet1に報告様式があること
②マクロのあるファイル(ブック)に”一括表示”のシートがあること
③上記①はおよそ100個ある前提です。
④上記①と②のファイルは同じフォルダにあること

添付の画像では
Book1.xlsx
Book2.xlsxが各支店からのファイル(ブック)
一括表示.xlsmがマクロのあるファイル(ブック)
になっています。


又、「実行時エラー"9"、インデックスが有効範囲にありません」
と表示されるのは、マクロのどの行でしょうか。
「複数の報告様式における記載事項を一括表示」の回答画像5
    • good
    • 0

No3です。


マクロは、一括表示シートの1行目は設定しません。あなたの方で、予め1行目の見出しを設定しておいてください。
マクロは2行目以降から設定を行います。
    • good
    • 0

以下のマクロを標準モジュールに登録してください。


Option Explicit


Public Sub 一括表示()
Dim ms As Worksheet '一活表示用シート
Dim maxrow As Long '一活表示用最大行番号
Dim mrow As Long '一活表示用行番号
Dim bookName As String
Application.ScreenUpdating = False
Set ms = Worksheets("一括表示")
maxrow = ms.Cells(Rows.Count, "A").End(xlUp).row
If maxrow > 1 Then
ms.Range("A2:G" & maxrow).Value = ""
End If
bookName = Dir(ThisWorkbook.Path & "\*.xlsx")
mrow = 1
Do While bookName <> ""
Call Read1Book(bookName, ms, mrow)
bookName = Dir()
Loop
Application.ScreenUpdating = True
MsgBox ("完了")
End Sub
Public Sub Read1Book(ByVal bookName As String, ByVal ms As Worksheet, ByRef mrow As Long)
Dim wb As Workbook
Dim ws As Worksheet '支所のシート
Dim maxrow As Long
Dim wrow As Long
Dim mcol As Long
Dim wcol As Long
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & bookName)
Set ws = wb.Worksheets("Sheet1")
maxrow = ws.Cells(Rows.Count, "A").End(xlUp).row
If maxrow < 29 Then
maxrow = 29
End If
For wrow = 5 To maxrow
mrow = mrow + 1
ms.Cells(mrow, "A").Value = ws.Cells(2, "C").Value '支所
ms.Cells(mrow, "B").Value = ws.Cells(wrow, "A").MergeArea(1).Value '項目
ms.Cells(mrow, "C").Value = ws.Cells(wrow, "B").Value '回数
ms.Cells(mrow, "D").Value = ws.Cells(wrow, "C").Value '人数
ms.Cells(mrow, "E").Value = ws.Cells(wrow, "D").Value '内容1
mcol = 5
For wcol = 5 To 7
If ws.Cells(wrow, wcol).MergeArea(1).Address <> ws.Cells(wrow, wcol - 1).MergeArea(1).Address Then
mcol = mcol + 1
ms.Cells(mrow, mcol).Value = ws.Cells(wrow, wcol).Value '内容2,3
End If
Next
Next
wb.Close

End Sub
    • good
    • 0
この回答へのお礼

tatsumaru77様
早速、素早い丁寧なご対応
誠に感謝しております。
こんなスキルを身につけられ
ほんと羨ましいです
勉強しながら、少しでも
頑張りたいと思います。

さて、分からない点があります。
そのまま作成いただいたプログラム
を標準モジュールにコピーしたのですが
sheet1に支店からの報告様式を入れて
sheet2に集約させるために
マクロを走らせたのですが
実行時エラー"9"
インデックスが有効範囲にありません
と表示されるのですが
そもそもやり方が間違ってるのでしょうか
どこかにフォルダを作って
収納したデータを読みに行く形なのでしょうか?
後記が理想なのですが
その場合フォルダ名の設置場所や名前は
どのようにすればいいでしょうか?
俺がほとんど質問になっていますが
どうぞ宜しくお願いします

お礼日時:2021/03/20 11:42

補足要求です。


1.各支所から送られてくるブックの拡張子はxlsxであってますか。

2.各支所から送られてくるブックの報告書のシート名はなんでしょうか。
(全支所共通のシート名であることが前提です。支所ごとにバラバラのシート名の場合、
マクロではどのシートを処理するのかわからなくなります)

3.各支所の報告書のレイアウトの正確なセル位置が不明です。
添付図で
Aの文字があるのは、C2
ミの文字があるのは、A29
であってますか。

3.各支所の報告書のレイアウトは、全支所で全て同じ前提で良いですか。
支所によって、レイアウトが少しでも異なると、マクロでは処理できなくなります。
例えば、ア、イ、ウ、エは各々5行ありますが、特定の支所のみ4行のところがあるようなケース。
例えば、アの内容は、4列が結合セルだが、特定の支所のみ2列が結合セルになるようなケース。
例えば、データ行は5行から29行になっているが、特定の支所のみ30行のケース。
上記のようなケースは全てNGですが、よろしいでしょうか。

4.マクロのあるブックに一括表示することになりますが、
一括表示するシート名は、何にしますか。
シート名:一括表示 で宜しければ、そうします。

5.マクロのあるブックと各支所から送られてくるブックは同じフォルダに格納する前提で良いですか。
また、そのフォルダには、上記以外のファイルは格納しない前提で良いですか。
「複数の報告様式における記載事項を一括表示」の回答画像2
    • good
    • 0

こんにちは



マクロで一括処理することは可能と思われますが、ご質問文に記載された情報からではマクロそのものを作成することは不可能です。

結局のところ、手作業を自動化するようなものですので、
 1)◇◇のファイルのシート××を開いて
 2)○○のセルの値を△△のセルに転記する
   ・・・・・・
といった内容を手順に沿って具体的に記述してゆくことになるからです。

お近くの同僚なりで、マクロに詳しい方がいれば、その方に協力してもらうか、あるいは外部の(作成してくれる)会社等に依頼するのがよろしそうに思われます。
    • good
    • 1
この回答へのお礼

早速のご回答ありがとうございます。
同僚の協力が得られず、質問させて
頂きました。
やはり努力して習得しなければ難し
しいですね。

お礼日時:2021/03/18 17:41

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング