人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

お世話になります。

エクセルのマクロで

フォルダを新しく作って、そこにエクセルシート上の特定箇所をテキストファイルで生成したいと思っています。

具体的には、

Sheet1の
行1にフォルダ名
行2にテキスト名
行3?行6にデータ

フォルダを作ってテキストファイルを生成するといった感じです。
行は複数行あって、行1のフォルダ名が同じ場合は、テキストファイルを同じフォルダに格納するようにもしたいのです。

例えば、
Sheet1が
A1:くだもの
A2:リンゴ
A3?A6:テキストデータ
B1:やさい
B2:ダイコン
B3?B6:テキストデータ
C1:やさい
C2:ナス
C3?C6:テキストデータ

となっていた場合、

「くだもの」と「やさい」というフォルダを作って、
「くだもの」には、「リンゴ.txt」
「やさい」には、「ダイコン.txt」「ナス.txt」
を入れるといった感じです。

どうぞ、宜しくお願い致します。

●質問者: pinko_pinpin
●カテゴリ:コンピュータ
✍キーワード:?B A1 A3 b2 C3
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● SALINGER
●100ポイント ベストアンサー

こんな感じでどうでしょうか

Sub Macro()
 Dim FSO
 Dim c As Long
  'ファイルを作る場所を指定
 Const myPath As String = "C:\Documents and Settings\hogehoge\デスクトップ\test1"
 
 c = 1
 Set FSO = CreateObject("Scripting.FileSystemObject")
 
  '同名フォルダが存在する場合のエラーを無視します
 On Error Resume Next
 
 While Cells(1, c).Value <> ""
 FSO.CreateFolder (myPath & "\" & Cells(1, c).Value)
 
 With FSO.GetFolder(myPath & "\" & Cells(1, c).Value).CreateTextFile(Cells(2, c).Value & ".txt")
 .WriteLine Cells(3, c).Value
 .WriteLine Cells(4, c).Value
 .WriteLine Cells(5, c).Value
 End With
 c = c + 1
 Wend
 On Error GoTo 0
 
 Set FSO = Nothing
End Sub

\を¥(半角)に置き換えてください。

http://q.hatena.ne.jp/

◎質問者からの返答

SALINGER様

完璧ですっ!!

ありがとうございました。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ