Memo/2004-06-28
をテンプレートにして作成
[
トップ
] [
新規
|
一覧
|
単語検索
|
最終更新
|
ヘルプ
]
開始行:
*Excel 関連情報 [#i886b393]
**サンプルコード [#d1615f0f]
***ADO を使ってシートを連結する方法 [#za42638b]
-複数シート/複数ファイルをマージするサンプル(merge_sheet...
Option Explicit
Dim g_strDIR
Dim g_strMergeData ' マージ対象のデータフォルダ
Dim g_strNewFile ' マージ先のファイル名
Dim g_strNewSheet ' マージ先のシート名
Main
' メイン プロシージャ
Sub Main()
g_strDIR = "D:\home\edu\hatena\merge_sheet\" ' ...
g_strMergeData = g_strDIR & ".\data" ' ...
g_strNewFile = g_strDIR & ".\merge.xls" ' ...
g_strNewSheet = "[Sheet1$]" ' ...
' 各シートをマージする
MergeSheets
End Sub
' 各シートをマージする
Sub MergeSheets()
Dim cn
Dim rs
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Sourc...
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Dim folder
Set folder = fs.GetFolder(g_strMergeData)
Dim file
Dim sheet
Dim sheets()
' ファイルの数だけ処理を行う
For Each file In folder.Files
GetSheetNames file, sheets
' ファイル内の各シートを新しいシートに挿入する
For Each sheet In sheets
Dim strSQL
strSQL = "INSERT INTO " & g_strNewSheet & " ...
' INSERT 文を実行
cn.Execute strSQL
Next
Next
End Sub
' 指定したファイルのシート名(複数シート名)を取得する
Function GetSheetNames(ByVal file, ByRef sheets())
Dim app
Set app = CreateObject("Excel.Application")
app.Workbooks.Open file
Dim i
Dim nSheets
nSheets = app.Worksheets.Count
ReDim sheets(nSheets - 1)
For i = 0 To nSheets - 1
' "シート名"+"$" を配列に格納
sheets(i) = "[Excel 8.0;database=" & file & "].[...
Next
app.Workbooks.Close
Set app = Nothing
End Function
-ダウンロード
#ref(merge_sheet.zip);
■ フォルダ構成
D:\HOME\EDU\HATENA\MERGE_SHEET
│ macro.vbs … XLSマージスクリプト(VBScriptバージョン)
│ macro.xls … XLSマージスクリプト(Excel/VBAバージョン)
│ merge.xls … マージ先のファイル
│ readme.txt … このファイル
│
└─data … マージ対象ファイル
aaa.xls
bbb.xls
ccc.xls
-制限事項
--マージ対象の Excel ファイルは、すべてのシートにデータが...
--空のシートがあるとエラーになります。ご注意下さい。
-はてな
--http://www.hatena.ne.jp/1088413798
---終わってしまったけど。
//#comment
終了行:
*Excel 関連情報 [#i886b393]
**サンプルコード [#d1615f0f]
***ADO を使ってシートを連結する方法 [#za42638b]
-複数シート/複数ファイルをマージするサンプル(merge_sheet...
Option Explicit
Dim g_strDIR
Dim g_strMergeData ' マージ対象のデータフォルダ
Dim g_strNewFile ' マージ先のファイル名
Dim g_strNewSheet ' マージ先のシート名
Main
' メイン プロシージャ
Sub Main()
g_strDIR = "D:\home\edu\hatena\merge_sheet\" ' ...
g_strMergeData = g_strDIR & ".\data" ' ...
g_strNewFile = g_strDIR & ".\merge.xls" ' ...
g_strNewSheet = "[Sheet1$]" ' ...
' 各シートをマージする
MergeSheets
End Sub
' 各シートをマージする
Sub MergeSheets()
Dim cn
Dim rs
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Sourc...
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Dim folder
Set folder = fs.GetFolder(g_strMergeData)
Dim file
Dim sheet
Dim sheets()
' ファイルの数だけ処理を行う
For Each file In folder.Files
GetSheetNames file, sheets
' ファイル内の各シートを新しいシートに挿入する
For Each sheet In sheets
Dim strSQL
strSQL = "INSERT INTO " & g_strNewSheet & " ...
' INSERT 文を実行
cn.Execute strSQL
Next
Next
End Sub
' 指定したファイルのシート名(複数シート名)を取得する
Function GetSheetNames(ByVal file, ByRef sheets())
Dim app
Set app = CreateObject("Excel.Application")
app.Workbooks.Open file
Dim i
Dim nSheets
nSheets = app.Worksheets.Count
ReDim sheets(nSheets - 1)
For i = 0 To nSheets - 1
' "シート名"+"$" を配列に格納
sheets(i) = "[Excel 8.0;database=" & file & "].[...
Next
app.Workbooks.Close
Set app = Nothing
End Function
-ダウンロード
#ref(merge_sheet.zip);
■ フォルダ構成
D:\HOME\EDU\HATENA\MERGE_SHEET
│ macro.vbs … XLSマージスクリプト(VBScriptバージョン)
│ macro.xls … XLSマージスクリプト(Excel/VBAバージョン)
│ merge.xls … マージ先のファイル
│ readme.txt … このファイル
│
└─data … マージ対象ファイル
aaa.xls
bbb.xls
ccc.xls
-制限事項
--マージ対象の Excel ファイルは、すべてのシートにデータが...
--空のシートがあるとエラーになります。ご注意下さい。
-はてな
--http://www.hatena.ne.jp/1088413798
---終わってしまったけど。
//#comment
ページ名: