2020年4月26日
今回は同じ書式の複数のワークブック・ワークシートを結合します。
JuseOffice02.zipにサンプルのスクリプトとデータが入っています。
イメージとしてはこんな感じです。
展示即売会をやって来客からアンケートの回答を得ました。
会場では山田グループ、高橋グループなど
10のグループが班ごとに分かれてブースを形成し、
それぞれがアンケートの回答を取りまとめました。
結果、10のExcelワークブックが集まりました。
一つのワークブックには複数のワークシートが入っています。
何枚のシートがあるかはそれぞれで異なります。
また、一枚のシートに何行書かれているかも様々です。
一人の回答は 1行になっていて、
「ID, 性別, 接客の満足度, 展示品の満足度, 次回参加の希望」の五項目。
満足度は 1~5の数値で記載。
これらの結合は、手作業でやるのはかなり大変です。
そこで自動操作で処理してみます。
merge03.wsf において、空欄を「無回答」に書き換える部分、
該当の列全体を書き換えるのではなく
該当のRange内についてだけ書き換えるように修正。
列全体となると、とんでもない個数のセルを書き換えることになってしまうので
なかなか終了せず、その後のピボット集計もちゃんと行われなかった。
JuseOffice02.zipを解凍すると SampleData というサブフォルダができて
その下に10個のExcelファイルがあるはずです。
乱数で生成した回答データです。
いきなり複数のワークブックを相手にするのは大変なので
まずは一つのワークブックに着目し、その中の複数のワークシートを結合します。
手順としては次のようになるでしょうか。
大まかな流れは以上のとおりです。
回答が書かれた複数のワークシートを処理する部分は
サブルーチン MergeData で処理することにして、
それ以外の大枠をスクリプトで書くと下のようになります。
[ワークブックを開く] "merge01.xlsx"
Set mergeSheet = [ワークシート] ' 結合した結果をこれに記録
headerArray = Split("ID 性別 接客の満足度 展示品の満足度 次回参加の希望")
mergeSheet.Range("A1:E1").Value = headerArray ' ヘッダの書き込み
bookPath = ".\SampleData\山田グループ.xlsx"
Call MergeData(bookPath, mergeSheet)
[ワークブックを保存] ' 結合結果を保存
[エクセルを終了]
まずは merge01.xlsx というワークブックを開いて
その中のワークシートを変数 mergeSheet にセットします。
この mergeSheet に結合結果をどんどん記録していきますが、
1行目には「ID, 性別, ……」のヘッダをあらかじめ書き込んでおきます。
JuseOfficeには [空でないワークシート群]
という関数があります。
戻り値は配列で、各要素にはワークシートオブジェクトがセットされています。
変数 [ワークブック]
が示すブックに含まれるワークシートのうち
空でないもの(何らかのデータが書かれている者)を抽出します。
空のワークシートのほか、非表示のシートも対象から外れます。
For Each ws In [空でないワークシート群]
MsgBox ws.Name
Next
上は、空でないワークシートのシート名を一つずつ表示します。
JuseOfficeには下のようなセルを特定する関数があります。
[先頭のセル]
: ワークシート内でデータが書かれている領域の先頭を返す。[末尾のセル]
: ワークシート内でデータが書かれている領域の末尾を返す。[新先頭のセル]
: ワークシート内でデータのない領域の新しい先頭を返す。 上の三つは変数 [ワークシート]
が指し示すワークシート内のセルを返します。
他のワークシートのセルを得たいときは on を付けて次のようにします。
[先頭のセルon](ws)
~ wsにはワークシートオブジェクトをセットしておく。
[末尾のセルon](ws)
,[新先頭のセルon](ws)
も同じです。
Set rng = ws.Range([先頭のセルon](ws), [末尾のセルon](ws))
上のようにすると、データが書かれている領域全体を
変数rngにセットすることになります。
これは Set rng = ws.UsedRange
と書くこともできます。
でも、今回はデータ領域全体をコピーするのでなく
1行目のヘッダを除いた残り全体をコピーするので
Offset を用いて下のようにします。
Set rng = ws.Range([先頭のセルon](ws).Offset(1), [末尾のセルon](ws))
Offsetは、基準となるセルから位置をずらしたセルを返します。
第一引数が行のずれ、第二引数が列のずれを示します。
cell.Offset(1)
だと1行下のセル、cell.Offset(0,1)
だと右隣のセル。
コピーしたい Range が決まったら、それを別のワークシートにコピーします。
rng.Copy destinationSheet.Range("A1")
上のようにすると destinationSheetのA1セル以降にrngのコピーが書き込まれます。
今回やりたい処理に即して書くと次のとおり。
rng.Copy [新先頭のセルon](destinationSheet)
[ワークブックを閉じる]
は、変数 [ワークブック]
が指し示すワークブックを閉じます。
他のワークブックを閉じたいときは [ワークブックを閉じるon] wb
のようにします。
[ワークブック]
を閉じた場合、変数 [ワークブック]
,[ワークシート]
にはそれぞれアクティブなワークブック,ワークシートが新たにセットされます。
以下にサブルーチン MergeData の実際のコードを掲げます。
呼び出す際の引数は
bookPath(読み込むExcelファイルのパス名)
mergeSheet(結合結果を記録するワークシート)
の二つです。
Sub MergeData(bookPath, mergeSheet)
[ワークブックを開く] bookPath
For Each ws In [空でないワークシート群] ' ワークシートを一つずつ処理
Set rng = ws.Range([先頭のセルon](ws).Offset(1), [末尾のセルon](ws))
rng.Copy [新先頭のセルon](mergeSheet)
Next
[ワークブックを閉じる] ' bookPathを閉じる
End Sub
上のサブルーチンを呼び出す側のスクリプトも改めて掲載しておきます。
[ワークブックを開く] "merge01.xlsx"
Set mergeSheet = [ワークシート] ' 結合した結果をこれに記録
headerArray = Split("ID 性別 接客の満足度 展示品の満足度 次回参加の希望")
mergeSheet.Range("A1:E1").Value = headerArray ' ヘッダの書き込み
bookPath = ".\SampleData\山田グループ.xlsx"
Call MergeData(bookPath, mergeSheet)
[ワークブックを保存] ' 結合結果を保存
[エクセルを終了]
zipファイルに入っている merge01.wsf を参考にしてください。
JuseOfficeには [ファイル名の一覧]
および [ファイル名の一覧をソート]
という関数があります。
ワイルドカードに該当するファイル名を抽出する関数です。
それらを用いて複数のワークブックを処理します。
[ファイル名の一覧]
は、引数で与えられたワイルドカードに該当するファイル名を配列として返します。
たとえば次のように用います。
wildName = ".\SampleData\*.xlsx"
fileList = [ファイル名の一覧](wildName)
For Each bookPath In fileList
MsgBox bookPath
Next
ファイル名がどんな順番になるかが不定です。
以下に merge02.wsf の主要部分を掲げます。
merge01.wsf を書き換えて複数のワークブックを扱うようにしました。
結合した結果は merge02.xlsx に書き出されます。
[ワークブックを開く] "merge02.xlsx"
Set mergeSheet = [ワークシート] ' 結合した結果をこれに記録
headerArray = Split("ID 性別 接客の満足度 展示品の満足度 次回参加の希望")
mergeSheet.Range("A1:E1").Value = headerArray ' ヘッダの書き込み
wildName = ".\SampleData\*.xlsx"
For Each bookPath In [ファイル名の一覧](wildName)
Call MergeData(bookPath, mergeSheet)
Next
Set ws = mergeSheet
Set startCell = [先頭のセルon](ws).Offset(1)
Set rng = ws.Range(startCell, [末尾のセルon](ws))
rng.Sort(startCell) ' IDに着目してソート
[ワークブックを保存] ' 結合結果を保存
[エクセルを終了]
【サブルーチン部分は省略】
結合処理が終了したあと、一応 IDによるソートを行っています。
集計の素材にするだけなら必ずしもソートの必要はありませんが……
[ファイル名の一覧をソート]
はワイルドカードに該当するファイル名をソートした上で配列に入れて返します。
ソートの手がかりとして、名前, 作成日時, 更新日時, サイズの四つを指定できます。
たとえば下のように使います。
wildName = ".\SampleData\*.xlsx"
fileList = [ファイル名の一覧をソート](wildName, "更新日時")
For Each bookPath In fileList
MsgBox bookPath
Next
上を実行すると、更新日時の古い順になります。
もし更新日時が同じなら、名前を手がかりにします。
第二引数を "更新日時 サイズ"
とすれば、
まず更新日時を手がかりにし、それが同じ場合にサイズを手がかりにします。
手がかりを複数指定するときは半角スペースで区切ります。
Null のような文字列でないものを第二引数にすると
"名前"
が指定されたものとみなされます。
「作成日時」は、ファイルが最初に作成された日時を示すかというと
必ずしもそうではないようです。
ファイルをコピーすると、コピー先での「作成日時」が変化します。
コピーしたときの日時になってしまい、
「更新日時」よりも新しい日付になったりするようです。
タイムスタンプを手がかりにする場合は「更新日時」の方がいいような気がします。
zipに入っている merge03.wsf は [ファイル名の一覧をソート]
を使う例です。
単に結合するだけではおもしろみがないので
結合した結果を素材として集計処理も行っています。
「性別」×「次回参加の希望」のクロス集計。
集計については別の機会にふれたいとおもいますが、
参考まで下に merge03.wsf の主要部分を掲げます。
[ワークブックを開く] "merge03.xlsx"
Set mergeSheet = [ワークシート] ' 結合した結果をこれに記録
headerArray = Split("ID 性別 接客の満足度 展示品の満足度 次回参加の希望")
mergeSheet.Range("A1:E1").Value = headerArray ' ヘッダの書き込み
wildName = ".\SampleData\*.xlsx"
For Each bookPath In [ファイル名の一覧をソート](wildName, "更新日時")
Call MergeData(bookPath, mergeSheet)
Next
' この先は集計のための操作
Set sourceSheet = [ワークシート]
sourceSheet.Name = "SourceSheet" ' ワークシート名を変更
Set rng = sourceSheet.UsedRange
For Each i In Array(2, 5) ' 2列, 5列の空欄を「無回答」に置換
rng.Columns(i).Replace "", "無回答", 1
Next
Set ws = [空のワークシート] ' これにピボットテーブルを作成
ws.Name = "PivotSheet"
Set pt = [ピボットテーブルの初期設定](sourceSheet, ws)
[度数と構成比を集計] pt, "次回参加の希望", "性別"
[ワークブックを保存]
[エクセルを終了]
【サブルーチン部分は省略】
Excelを起動せずに、xlsxファイルをデータベースとして扱うことができます。
そのやり方で結合処理を施すと、
Excelを起動しないので迅速に処理できます。
データベースの処理については別の機会にふれたいとおもいますが、
参考までスクリプトを掲げておきます。
merge04.wsf を実行すると merge04.xlsx が作成されます。
これには merge, MergeSort の二つのワークシートができているはずです。
後者は ID によって昇順にソートした結果です。
もし merge04.wsf がうまく動作しないときは、
3行目の 'RunOn32bit
の先頭の '
を削除してみてください。
それでも動作しないとなると、ADO用のドライバーがインストールされていない可能性が大きいです。あまりないとはおもいますが……
以下、スクリプトの主要部分です。
mergeFile = "merge04.xlsx"
mergeTable = "merge"
If [ファイルがある](mergeFile) Then [ファイルを削除] mergeFile
Set mergeCN = [データベースを開く](mergeFile)
typeStr = "ID int,性別 varchar,接客の満足度 int," & _
"展示品の満足度 int,次回参加の希望 varchar"
[データベースの表を作成on] mergeCN, mergeTable, typeStr
For Each bookPath In [ファイル名の一覧](".\SampleData\*.xlsx")
Call MergeExcelFiles(bookPath, mergeCN, mergeTable)
Next
sql = "select * into [MergeSort] from [" & mergeTable & "] order by ID"
mergeCN.Execute(sql)
[データベースを閉じるon] mergeCN
Sub MergeExcelFiles(ByVal bookPath, mergeCN, ByVal mergeTable)
[データベースを開く] bookPath
Set tableDict = [データベースの表の一覧]
For Each tableName In tableDict.Keys
If Right(tableName, 1) = "$" Then
sql = "select * from [" & tableName & "]"
ary = [データベースから配列へ](sql)
[配列からデータベースへon] mergeCN, mergeTable, ary
End If
Next
[データベースを閉じる]
End Sub
~ 以上 ~
Copyright (C) T. Yoshiizumi, 2020 All rights reserved.