エクセルの各セルの内容をそれぞれ1つずつテキストファイルに出力する方法

解決済

質問者：iloveganko
質問日時：2009/07/04 00:35
回答数：3件

掲題の件についてご存知の方がいらっしゃいましたらご教示ください。

エクセルファイルの列Aの内容がタイトルで、列Bの内容が本文であるテキストファイルを作成したいと考えています。

例えば、エクセルファイルに以下のようなデータを保持しているとします。
列A　　列B
001　　あいうえお
002　　かきくけこ
003　　さしすせそ

この場合、001.txtは本文が「あいうえお」、002.txtは本文が「かきくけこ」、003.txtは本文が「さしすせそ」というように、エクセル1行についてテキストファイルを1つ作成したいと考えています。

このような処理を短時間で実施するのに適した方法をご存知の方がいらっしゃいましたらご教示いただければと思います。

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

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (3件)

ベストアンサー優先
最新から表示
回答順に表示

No.3ベストアンサー

回答者： mitarashi
回答日時：2009/07/04 11:08

Wendy02さんとかぶってしまいました。

ほぼ同じ事をしていますが、折角作ったので、投稿しておきます。
空白行を出力する事は無いだろうと、上から空セルが出現するまでループしています。1000文字以上のセルで動作確認しました（XL2000）。
My Doocumentsに作成する仕様です。
Sub Sample()
Dim FSO As Object
Dim filePath As String
Dim i As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
filePath = getMyDocumentsPath & "\"
i = 1
Do While Range("A" & i).Value <> ""
With FSO.OpenTextFile(filePath & Range("A" & i).Value & ".txt", iomode:=2, create:=True)
.Write Range("B" & i).Value
.Close
End With
i = i + 1
Loop
Set FSO = Nothing
End Sub

Private Function getMyDocumentsPath() As String
Dim objWshShell As Object

Set objWshShell = CreateObject("Wscript.Shell")
getMyDocumentsPath = objWshShell.SpecialFolders("MyDocuments")
Set objWshShell = Nothing
End Function

- 3
- 件

通報する

この回答へのお礼

どうもありがとうございます。こちらのモジュールで問題なく実行できました。テストまでしていただいて本当にありがたいです。

今後とも何かありましたらどうぞよろしくお願いいたします。

通報する

お礼日時：2009/07/06 00:57

No.2

回答者： Wendy02
回答日時：2009/07/04 10:53

こんにちは。

出力する場所を自分の場所に合わせて実行してください。

'---------------------------------------------------
'標準モジュール

Sub OutPutMacro()
　　Dim fs As Object
　　Dim objTxt As Object
　　Dim i As Long
　　Dim orgPath As String
　　orgPath = CurDir
　　'上書きオプション
　　Const OVRW As Boolean = False
　　'出力する場所
　　ChDir "D:\"
　　
　　Set fs = CreateObject("Scripting.FileSystemObject")
　　For i = 1 To Range("A65536").End(xlUp).Row
　　　　If Cells(i, 1).Value <> "" Then
　　　　　　Set objTxt = fs.CreateTextFile(Cells(i, 1).Text & ".txt", OVRW)
　　　　　　objTxt.WriteLine (Cells(i, 2).Text)
　　　　　　objTxt.Close
　　　　End If
　　Next i
　　ChDir orgPath
　　Set fs = Nothing
End Sub