[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数Bookのデータを処理して一つのブックを作成したい。』（イソギです）
初めて活用させていただきます。
簡単にはタイトルの通りなのですが、複数のブックに対するVBAの構築に疎く、自力で検索してみましたが、うまくいかないので教えてください。
フォルダの構成としては
フォルダ1＞フォルダ?@〜㉚＞Book?@〜㉚-1〜21
のようにBookまで3段で構成されておりまして、
各Bookに対して同じ処理を実施して、まったく別のbookを作成することを想定しております。
出力Bookの理想形は、
1つのブックに対してフォルダ1〜30のシートを作成し、各シートにおいてBook1〜21のデータを処理したものを出力したいです。
想定しているのは、
データが格納されているフォルダを選択（フォルダ1）→各データを処理→
出力Bookを作成
→シート1（フォルダ?@）を作成→Book?@-1〜21を処理したデータを出力→
→シート2（フォルダ?A）を作成→Book?A-1〜21を処理したデータを出力→
→シート3...
というようなルーチンを想定しております。
ここで必要なルーチンとして、
Bookごと及びフォルダ毎に変数に格納する必要があると考えているのですが、
可能でしょうか。
例えば、フォルダ?@のブック?@-1のデータだったら、data(1,1)として扱うなど
また、上記の構文等についてもご教授いただければ幸いです。
また、私の知識では上記方法以外思いつかないのですが、何か方法がございましたら教えていただけますでしょうか。
わかりづらくて申し訳ございませんが、よろしくお願いいたします。
＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞
＞Book?A-1〜21を処理したデータを出力
どのような処理でしょうか （マナ） 2023/11/09(木) 16:25:36
骨格だけ
Sub sample()
Dim FolderPath As String, oFolder As Object, subFolder As Object, File As Object
Dim newWB As Workbook, ws As Worksheet, WB As Workbook
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
FolderPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
With CreateObject("Scripting.FileSystemObject")
Set oFolder = .GetFolder(FolderPath)
End With
Set newWB = Workbooks.Add
For Each subFolder In oFolder.SubFolders
Set ws = newWB.Worksheets.Add
ws.Name = subFolder.Name
For Each File In subFolder.Files
If File.Path Like "*.xls*" Then
Set WB = Workbooks.Open(File.Path)
subProc ws, WB
WB.Close False
End If
Next
Next
End Sub
Sub subProc(ws As Worksheet, WB As Workbook)
'WBの中身をなんだかかんだかしてwsに転記する処理
End Sub
（´・ω・`） 2023/11/09(木) 16:37:05
■データが格納されているフォルダの構成
c:\階層１
├階層２-01
│ Book0101.xlsx
│ Book0102.xlsx
│ ・
│ ・
│ Book0121.xlsx
│
├階層２-02
│ Book0201.xlsx
│ Book0202.xlsx
│ ・
│ ・
│ Book0221.xlsx
│ ・
│ ・
│ ・
└階層２-30
Book3001.xlsx
Book3002.xlsx
・
・
Book3021.xlsx
■ 出力用ブックの構成
Workbook
├Worksheets("階層２-01")
├Worksheets("階層２-02")
│ ・
│ ・
│ ・
└Worksheets("階層２-01")
それならば↓のような処理をすればよいと思います。
階層２の【各フォルダ】を巡回し、
その【フォルダ内】の【ファイル】を巡回し
もしも、Excelブックだったら開く
必要な処理（該当するシートへ書き込み？）
ブックを閉じる
もしもの話はおしまい
全部の【ファイル】を巡回したら終わり
全部の【フォルダ】を巡回したらおわり
ただ、いきなり考えると混乱すると思うので、まずは【１つのフォルダ】、【１つのブック】で考えるとよいと思います。
（繰り返し処理の部分はそれから考えても遅くないはずです）
（もこな２ ） 2023/11/09(木) 16:40:10
ご回答ありがとうございます。
勉強不足で申し訳ないのですが、いただいた構文をすぐに理解できないので、
お時間をください。
よろしくお願いいたします。
（イソギです） 2023/11/09(木) 16:48:10
フォルダ構成の整理ありがとうございます。
おっしゃる通りの構成でございます。
私もマクロが得意な方ではないので、昨日Bookに対する処理を一通り完成させ、
本日、作成したマクロをフォルダ内のすべてのBookに展開させようと考えていたのですが、手詰まりでして。。。
ご提案いただいたルーチンを考えてはいたのですが、
書き込みの部分を処理のルーチンに入れると速度が落ちることから、
各Bookの値を変数化して格納したのちに、
すべてのデータを出力しようと考えての質問でした。
そのためフォルダおよびBookをi,jのように変数として扱うことは可能ですかと質問させていただきました。
（イソギです） 2023/11/09(木) 16:53:40
>昨日Bookに対する処理を一通り完成させ それをここに書き込んだら、アドバイスがもらえるかもしれませんよ （´・ω・`） 2023/11/09(木) 17:10:51
この部分の処理は本当に読込みデータの合計を出したりするだけの処理なので、
今回質問させていただいた部分には、そこまで大きく影響してこないだろうという見解でおりました。。
（イソギです） 2023/11/09(木) 18:16:41
■１
＞私もマクロが得意な方ではないので、昨日Bookに対する処理を一通り完成させ、
＞本日、作成したマクロをフォルダ内のすべてのBookに展開させようと考えていたのですが、手詰まりでして。。。
既に指摘があるところではありますが、何がどう手詰まりなのかそのコードを示して説明できませんか？
■２
＞書き込みの部分を処理のルーチンに入れると速度が落ちる
ニックネームからして急いでいるのではありませんか？
わからない（理解できていない）技術を使用したコード作成に時間をかけるより
1. 処理に時間を要してもいいのでとりあえず理解できる方法で完成させる。 2. 時間に余裕ができたら別アプローチの学習をするなどして改良する
とされたほうが総合的に効率が良いように思います。
（もこな２ ） 2023/11/09(木) 20:32:51
私のアドバイスは不要なようなので私は撤退します （´・ω・`） 2023/11/09(木) 21:20:30
> 書き込みの部分を処理のルーチンに入れると速度が落ちることから、 > 各Bookの値を変数化して格納したのちに、 > すべてのデータを出力しようと考えての質問でした。 > > そのためフォルダおよびBookをi,jのように変数として扱うことは可能ですかと質問させていただきました。
可能です。 （´・ω・`）さんの提示のコードは、フォルダーをsubFolderという変数、ブックをWBという変数に代入して処理してます。
処理対象のブック数がどのくらいか不明ですが、 ブックを開くという処理はそれなりに重い処理です。 フォルダやブックを変数化したとしても、ブックを開くという処理に 変わりはないのでそれで高速化はしません。
複数のフィールド内の複数のブックを開いて順次処理するのは（´・ω・`）さんの提示のコードが最善のもののひとつです。
そこで、
> この部分の処理は本当に読込みデータの合計を出したりするだけの処理なので、 > 今回質問させていただいた部分には、そこまで大きく影響してこないだろうという見解でおりました。
という見解がはたして妥当だろうか、そこに改善の余地はないのだろうか、という見解がでてきます。 ですので、「読込みデータの合計を出したりするだけの処理」の部分のコードを提示したら、 なにかアドバイスができるのでは、とみなさんはおっしゃってます。
そのうえで、もし、そこに改善の余地がないのなら、ブックを開かずにデータを読み込む方法を検討する という流れにするのが効率的だと私も思います。
ブックを開かずにデータを取得する方法としては、パワークエリとかADOとかありますが、 どちらもそれなりに学習コストを要しますので。
（hatena） 2023/11/10(金) 01:31:25
お時間いただきありがとうございます。
上記レスの読込みデータのプログラムを記載させていただきます。
（もこな２ ）様
■1
ご助言の通りコードを記載させていただきました。
Bookを選択し、シート内のデータを読込もろもろの処理をしたのちに、
Bookを作成し、処理後のデータを記入する流れとなっております。
この処理を整理していただいた階層1を選択した際に、下階層のBookすべてに適用し、まとめて一つのBookに出力できたらなと考えておりました。
c:\階層１
├階層２-01
│ Book0101.xlsx
│ Book0102.xlsx
│ ・
│ ・
│ Book0121.xlsx
│
├階層２-02
│ Book0201.xlsx
│ Book0202.xlsx
│ ・
│ ・
│ Book0221.xlsx
│ ・
│ ・
│ ・
└階層２-30
Book3001.xlsx
Book3002.xlsx
・
・
Book3021.xlsx
■ 出力用ブックの構成
Workbook
├Worksheets("階層２-01")
├Worksheets("階層２-02")
│ ・
│ ・
│ ・
└Worksheets("階層２-01")
■2
おっしゃる通りですね。時間がないのであれば可能なコードを書く方が結果的に時間ロスは少ないです。
ありがとうございます。
（´・ω・`）様
気分を害してしまい申し訳ございません。
（hatena） 様
ご解説ありがとうございます。
下記のような処理を（もこな２ ）様がまとめてくださったフォルダ構成の階層1を選択した段階で、
下の階層のBookにおいて処理できるような方法はございますでしょうか。という趣旨でした。
これを8000弱のBookに対して実施するため、
開く（読み）→読込み→閉じる（読み）→開く（書き）→書き込む→閉じる（書き）
を行うと時間が倍近く時間がかかるのではないかと思った次第でございます。
想定では、
現状、各Bookの値を配列に格納しているため、
階層（1）-階層（1-1）-Book（1-1）の値は、data(1,1,1)というように配列に格納することが可能であれば、書き込むためのBookは最後にのみ開き、出力することが可能なのではないかと考えておりました。
また、出力フォーマットとしてシートを階層（1-1）…階層（1-30）の名前として、各シートに対してBook（1-1）、Book（1-2）…Book（1-21）の処理したデータを記入するということを想定しておりました。
――――――――――――――――――――――――――――――――――――
Sub pgm123()
Application.ScreenUpdating = False
'Dim WB As Workbook
Dim File As String
Dim Sheetname As String
Dim LastRow As Long, LastRowANA As Long
Dim title(1) As String, STR As String, ANAdate() As String
Dim RR() As Double
Dim I As Long, II As Long, J As Long, Num As Long, NN As Long, NMAX As Long
Dim Nod As Long
Dim Pos As Long
Dim Filename As String, Directory As String
Set WB = ThisWorkbook
With Application.FileDialog(msoFileDialogFilePicker)
If .Show = 0 Then
Exit Sub
End If
wb_path = .SelectedItems(1)
End With
Pos = InStrRev(wb_path, "\")
Filename = Mid(wb_path, Pos + 1)
Nod = Cells(9, 2)
Workbooks.Open Filename:=wb_path
Set WB = ActiveWorkbook
Debug.Print (WB.Name)
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
LastRowANA = LastRow - 2
ReDim RR(LastRowANA), ANAdate(LastRowANA)
title(1) = Cells(1, 2)
STR = "aaaaaaaaaaaaaaaaaaaaaa"
title(1) = Mid(title(1), Len(STR) + 1)
For I = 1 To LastRowANA
ANAdate(I) = Cells(I + 2, 1)
RR(I) = Cells(I + 2, 2)
Next
'/////////////////////////////////////////////////////////////////////////////
Dim dSUM(1 To 365) As Double, dSUM1 As Double
Dim SDate(1 To 365) As String, EDate(1 To 365) As String
Dim KOSU(1 To 365) As Long, RKosu As Long, dI(1 To 365, 1 To 1000) As Long
RKosu = 1
dSUM1 = 0
KOSU(1) = 0
dSUM(1) = 0
For I = 1 To LastRowANA
If RR(I) > 0# Then
KOSU(RKosu) = KOSU(RKosu) + 1
dI(RKosu, KOSU(RKosu)) = I
For II = 1 To Nod
dSUM1 = dSUM1 + RR(I + II)
Next
If dSUM1 = 0# Then
dSUM(RKosu) = dSUM(RKosu) + RR(I)
EDate(RKosu) = ANAdate(I)
RKosu = RKosu + 1
KOSU(RKosu) = 0
dSUM(RKosu) = 0
Else
dSUM(RKosu) = dSUM(RKosu) + RR(I)
End If
dSUM1 = 0
End If
Next
RKosu = RKosu - 1
For I = 1 To RKosu
SDate(I) = ANAdate(dI(I, 1))
Next
WB.Close
'/////////////////////////////////////////////////////////////////////////////
Dim Save_path As String, SName As String, Newbook As Workbook
SName = "bbb.xlsx"
Save_path = Cells(6, 2) & "\" & SName
Set Newbook = Workbooks.Add
Newbook.SaveAs Save_path
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name = "2080" Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True
Worksheets.Add(AFTER:=Sheets(Sheets.Count)).Name = "ccc"
Cells(1, 1) = title(1)
For I = 1 To RKosu
Cells(I + 1, 1) = SDate(I)
Cells(I + 1, 2) = EDate(I)
Cells(I + 1, 3) = dSUM(I)
Next
Application.ScreenUpdating = True
End Sub
Workbooks(Filename).Activate
UserForm1.ListBox1.Clear
For idx = 1 To Worksheets.Count
UserForm1.ListBox1.AddItem Worksheets(idx).Name
Next idx
UserForm1.Show
End Function
（イソギです） 2023/11/10(金) 16:34:46
■４
＞開く（読み）→読込み→閉じる（読み）→開く（書き）→書き込む→閉じる（書き） ＞を行うと時間が倍近く時間がかかるのではないかと思った次第でございます。
理解できません。
少なくとも、出力側のブックは開きっぱなしになるのではありませんか？
（もこな２ ） 2023/11/13(月) 09:11:32
お読みいただきありがとうございます。
何とか解決できそうです。
お時間割いていただきありがとうございました。
今後ともよろしくお願いいたします。
（イソギです） 2023/11/13(月) 09:51:26
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.