FrontPage 新規 編集 検索 一覧 ヘルプ

BBS-雑談/7

テキストファイルからエクセルファイルへ - のぶこ (2003年09月26日 09時06分26秒)

VBScriptで次のようなことが出来るのかご助言ください。

入力ファイル = input.txt (普通のテキストファイル)出力ファイル = output.xls (マクロの仕込んだエクセルファイル)

入力ファイルを読み込み、出力ファイルに書き出し、マクロを実行する。

この繰り返しをSheetを増やしながら行う。

入力ファイルのフォーマットは次のような感じです。

sheet_1A1,B1,C1,D1,E1,F1,G1,H1,I1,J1,K1,L1.・・・A2,B2,C2,D2,E2,F2,G2,H2,I2,J2,K2,L2.・・・A3,B3,C3,D3,E3,F3,G3,H3,I3,J3,K3,L3.・・・A4,B4,C4,D4,E4,F4,G4,H4,I4,J4,K4,L4.・・・・・・sheet_2A1,B1,C1,D1,E1,F1,G1,H1,I1,J1,K1,L1.・・・A2,B2,C2,D2,E2,F2,G2,H2,I2,J2,K2,L2.・・・A3,B3,C3,D3,E3,F3,G3,H3,I3,J3,K3,L3.・・・A4,B4,C4,D4,E4,F4,G4,H4,I4,J4,K4,L4.・・・・・・sheet_nA1,B1,C1,D1,E1,F1,G1,H1,I1,J1,K1,L1.・・・A2,B2,C2,D2,E2,F2,G2,H2,I2,J2,K2,L2.・・・A3,B3,C3,D3,E3,F3,G3,H3,I3,J3,K3,L3.・・・A4,B4,C4,D4,E4,F4,G4,H4,I4,J4,K4,L4.・・・・・・

新しいSheetの始まりはSheet_番号でSheet_番号がそのままSheet名になります。Sheet_番号は始まりを認識するキーであり書き出しは行われません。A1〜L4は可変でカンマで区切られています。

初心者で右も左も分からずに困っています。C言語の経験は若干あるのですが・・・何卒どうぞよろしくおねがいします。

のぶこ

エラー処理などしていませんが、VBSでのサンプル作成したので参考にしてください。OUTPUT_XLS は作成されます。存在チェックなどしていません。

input.txtを含むプログラムファイルです。>> text2xls.lzh

 Option Explicit
 ' text2xls.vbs - テキストファイルからエクセルファイルへ
 ' 2003/09/26 by tuka.
 
 ' リテラル・設定など
 Const INPUT_TEXT = "C:\Datas\input.txt"
 Const OUTPUT_XLS = "C:\Datas\output.xls"
 
 ' テキストファイル読み込み用
 Dim objFS, objText
 Set objFS = CreateObject("Scripting.FileSystemObject")
 Set objText = objFS.OpenTextFile(INPUT_TEXT)
 
 ' エクセルオートメーション用
 Dim objExcel, objWB, objWS
 Set objExcel = CreateObject("Excel.Application")
 ' 新規にブックを作成
 Set objWB = objExcel.Workbooks.Add
 
 ' 正規表現用(シート名取得用)
 Dim objRE
 Set objRE = New RegExp
 objRE.Pattern = "^sheet_\d+$"        ' シート名パターン
 
 Dim strLine, arrData
 Dim iRow, iCol
 While Not objText.AtEndOfStream
     strLine = objText.ReadLine           ' 一行読み込み
     If objRE.Test(strLine) Then          ' シート名なら・・・
         Set objWS = objWB.Sheets.Add         ' ワークシート追加
         objWS.Name = strLine                 ' シート名設定
         iRow = 1                             ' 行を先頭にセット
     Else                                 ' シート名でなければ・・・
         arrData = Split(strLine, ",")        ' データ取得
         For iCol = 1 To UBound(arrData) + 1  ' フィールド数ループ
             objWS.Cells(iRow, iCol) = arrData(iCol - 1)
         Next
         iRow = iRow + 1
     End If
 Wend
 
 ' 作成したブックをセーブ
 objWB.SaveAs OUTPUT_XLS
 objWB.Close
 
 ' インスタンス廃棄
 Set objWS = Nothing
 Set objWB = Nothing
 Set objRE = Nothing
 Set objText = Nothing
 Set objFS = Nothing
 Set objExcel = Nothing
 
 ' 終了メッセージ
 WScript.Echo "作成しました!"

{{comment}}

Yesterday Today Total