ファンタビの世界観を作る二人にインタビュー!

エクセルに入力済みの連続したデータを1行単位で以下のような内容でテキストファイルを作成し、
かつテキストファイル名を、セルに入力されている文字を使って保存するマクロを作りたいのですが、
どのようにしたら良いのでしょうか?よろしくお願いします。

*エクセルシート
(ファイル名:aaa.xls シート名:sheet1 エクセルシートがあるフォルダ名:yyy)

_|A |B |C |
1|x |y |z |
2|a1|a2|a3|
3|b1|b2|b3|

*テキストファイル(保存するフォルダ名:zzz)

---テキストファイルの内容(ファイル名:a1.txt)
x
a1

y
a2

z
a3
---
---テキストファイルの内容(ファイル名:b1.txt)
x
b1

y
b2

z
b3
---

エクセルはExcel2000でWindows2000を使用しております。

このQ&Aに関連する最新のQ&A

A 回答 (3件)

このマクロは、そのデータとは関係のない余計なデータが右側セル、下側にあると、誤動作しますので、その点は注意してください。


必ず、<標準モジュール>でお使いください。

'目的のブックのシートを開いたままお使いください。
Sub ColumnOut2Text()
Dim i As Long
Dim j As Long
Dim Fno As Integer
Dim OutColumn As String
'ユーザー設定
  Const myPath As String = "C:\ZZZ\"
 'かならず、最後に\ を入れてください。
'
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
 Fno = FreeFile()
 Open myPath & .Cells(i, 1).Value & ".txt" For Output As #Fno
 For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
  OutColumn = .Cells(1, j).Value & Chr(13) & .Cells(i, j).Value & Chr(13)
  Print #Fno, OutColumn
 Next j
 OutColumn = Empty
 Close #Fno
Next i
End With
 Beep
End Sub
    • good
    • 0
この回答へのお礼

できました!ありがとうございます。

お礼日時:2005/05/10 16:05

#1です。


保存するフォルダの指定がありました。
Dpath="zzz" としてください。
このままだと、Excelファイルのあるパスに保存します。
    • good
    • 0
この回答へのお礼

了解しました。

お礼日時:2005/05/10 16:07

これでどうですか。


Sub テキストファイル出力()

Sheets("sheet1").Select
i = 2
Dpath = ActiveWorkbook.Path
While Cells(i, 1) <> ""
Open Dpath & "\" & Cells(i, 1) & ".txt" For Output As #1
For j = 1 To 3
Print #1, Cells(1, j)
Print #1, Cells(2, j)
Print #1, ""
Next j
Close
i = i + 1
Wend

End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。やってみましたが、何も保存されませんでした。

お礼日時:2005/05/10 16:06

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

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

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

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

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

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

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

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

Aベストアンサー

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

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 Ran...続きを読む

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QChr(13)とChr(10)の違いは?

myStr = Replace(myStr, Chr(13), "")

myStr = Replace(myStr, Chr(10), "")

で、改行を置換しているのですが、どちらかでも改行できる時や
どちらかじゃないと改行できない時があります。

そもそもChr(13)とChr(10)の違いはなんでしょう?
どちらも改行ですよね?
何が違うのでしょう?

Aベストアンサー

こんにちは。お邪魔します。

Chr(10) ・・・ ラインフィード ・・・ 略して、Lf

Chr(13) ・・・ キャリッジリターン ・・・ 略して、Cr

改行文字に何を使うのかはアプリケーションが規定するものです。

Win・Office環境では
上のふたつを組合わせた改行[CrLf]を使うことが多いと思います。
次に[Lf]、そして、[Cr]

なので、ソースによっては
  myStr = Replace(myStr, vbCrLf, "")
と、一発で置換できるケースも少なくないです。
■ソースごとに改行文字を確認しておくことから始めた方が有利になります。■

ひとまず、VBAでの改行の扱いに慣れるには
■VBAで用意された文字列定数について知っておいた方がよいと思います。■
 VBE(Visual Basicの編集画面)が開いている状態で、
 F2 キー → オブジェクトブラウザー起動
 検索小窓に、vbCrLf、とタイプして、検索ボタン
 VBA.Constantsクラスのメンバーが表示され
 その中にすべての改行文字(文字列定数)が含まれています。
 そのまま、F1 キーでヘルプを表示します。
詳しい説明はヘルプを読む方がいいでしょう。

実践的な話として、
Chr(10)やChr(13)は関数の戻り値です。
対して、
vbLfやvbCr(またはvbCrLf)は定数です。
定数で済ませられるなら、定数の方が何かと有利です。
定数の名前は略号ですから、実態をイメージし易くなっています。
定数の扱いに慣れることをお奨めします。
例)
  myStr = Replace(myStr, vbLf, "")
  myStr = Replace(myStr, vbCr, "")
  myStr = Replace(myStr, vbCrLf, "")

もしも文字列定数を先に覚えていたなら、疑問にもならなかったのかも知れませんね。
私の場合は、改行の何たるかを覚える前に文字列定数覚えていて、困ることありませんでしたから。

以上、ご参考まで。

こんにちは。お邪魔します。

Chr(10) ・・・ ラインフィード ・・・ 略して、Lf

Chr(13) ・・・ キャリッジリターン ・・・ 略して、Cr

改行文字に何を使うのかはアプリケーションが規定するものです。

Win・Office環境では
上のふたつを組合わせた改行[CrLf]を使うことが多いと思います。
次に[Lf]、そして、[Cr]

なので、ソースによっては
  myStr = Replace(myStr, vbCrLf, "")
と、一発で置換できるケースも少なくないです。
■ソースごとに改行文字を確認しておくことから始めた方が有利...続きを読む

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub

QエクセルVBA テキストに出力、名前を付けて保存

エクセルVBA テキストに出力、名前を付けて保存
   A  B   C   D
1  aa  bb  cc  =A1&B1&C1
2  dd  ee  ff  =A2&B2&C2
3  gg  hh  ii  =A3&B3&C3


上記エクセルのD列の内容(セルA1~C3が連続したもの)を1行毎にテキストに出力し、
B列の内容をファイル名にしてテキストファイルを多量に自動生成したいのです。

上記エクセルのように3行なら下記の3つのファイルが生成されるといったVBAがほしいのです。

ファイル名がbb.txtで、テキストの内容はaabbcc。
ファイル名がee.txtで、テキストの内容はddeeff。
ファイル名がhh.txtで、テキストの内容はgghhii。


実際は数千行あるので、数千ファイルを一気に生成させたいのです。

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

Aベストアンサー

1>1  aa  bb  cc  =A1&B1&C1 

2>実際は数千行あるので、数千ファイルを一気に生成させたいのです。

3>ファイル名がbb.txtで、テキストの内容はaabbcc。

ちょっと説明不足のような気もしますが、このままで出力したら、必ず、同じものが出てきてしまいます。それを考慮して作れば、以下のようになります。

'//
Sub TestMacro()
 Dim i As Long, k As Variant, j As Long
 Dim fn As String
 Dim mPath As String
 Dim rng As Range, ar As Variant
 Dim buf As String
 Set rng = Range("A1", Cells(Rows.Count, 1).End(xlUp).Offset(, 2))
 
 mPath = CurDir 'パスを決める(CurDir は、カレントディレクトリ)
 
 ar = rng.Value
 For i = 1 To rng.Rows.Count
  fn = ar(i, 2) & ".txt"
  Do Until Dir(mPath & "\" & fn) = ""
   k = Val(k) + 1
   j = InStr(1, fn, "(", 1)
   If j > 0 Then
    fn = Mid(fn, 1, j - 1) & "(" & k & ")" & ".txt"
   Else
    fn = Replace(fn, ".txt", "", , , 1) & "(" & k & ")" & ".txt"
   End If
  Loop
  Open fn For Output As #1
  Print #1, ar(i, 1) & ar(i, 2) & ar(i, 3)
  Close #1
  k = ""
 Next
 If Len(buf) > 2 Then
  MsgBox Mid(buf, 2) & vbCrLf & "重複のため保存は省かれました。"
 Else
  MsgBox mPath & "に出力されました。"
 End If
End Sub

1>1  aa  bb  cc  =A1&B1&C1 

2>実際は数千行あるので、数千ファイルを一気に生成させたいのです。

3>ファイル名がbb.txtで、テキストの内容はaabbcc。

ちょっと説明不足のような気もしますが、このままで出力したら、必ず、同じものが出てきてしまいます。それを考慮して作れば、以下のようになります。

'//
Sub TestMacro()
 Dim i As Long, k As Variant, j As Long
 Dim fn As String
 Dim mPath As String
 Dim rng As Range, ar As Variant
 Dim buf As String
 Set rng = Range("A1", C...続きを読む

QExcelでセル内の文字をファイル名にする方法と、下のSheet1タブを2列にする方法は?

Excel2003です。OSはWinXPです。質問は2つです。

1.セル内の文字をファイル名にする方法は?
例えばA1セルに 1153 と入っていたら、ファイルの名前を付けて保存するとき、普通は Book1.xls となりますが、
これを 1153.xls とするにはどうしたらよいですか?

2.下のSheet1タブを2列にする方法は?
EXcelの下の方にシート切り替えがありますが、これを2列にするにはどうしたらよいですか?

Aベストアンサー

1は、前回の回答で間違いありませんが、もう少し詳しく処理方法を書きます。

(1)そのBookを開き、ツール→マクロ→新しいマクロの登録を選択。
(2)ダイアログボックスを確認、マクロ名(今回はMacro1のまま)を入力し、OK。
(3)そのBookを適当な名前(今回はBook1)で保存し、マクロの記録を終了。
(4)ツール→マクロ→マクロを選択、マクロ名を選択し、編集ボタンを押す。
すると、下記のようなモジュールが現れる。
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2006/8/29
'
ChDir "C:\Documents and Settings\管理者\保存するフォルダ○○"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\管理者\保存するフォルダ○○\Book1.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub

ので、Filename:=の後の " から .xls" までを Range("A1") & ".xls" と変更する。

2については済みません。解りません。

1は、前回の回答で間違いありませんが、もう少し詳しく処理方法を書きます。

(1)そのBookを開き、ツール→マクロ→新しいマクロの登録を選択。
(2)ダイアログボックスを確認、マクロ名(今回はMacro1のまま)を入力し、OK。
(3)そのBookを適当な名前(今回はBook1)で保存し、マクロの記録を終了。
(4)ツール→マクロ→マクロを選択、マクロ名を選択し、編集ボタンを押す。
すると、下記のようなモジュールが現れる。
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2...続きを読む

Qエクセルで特定の列だけを抽出してcsvで保存したい

エクセルで特定の列だけを抽出してcsvで保存したい

例えば、A列:住所、B列:氏名、C列:電話番号といった3つの列がありそれぞれデータがはいっているとします(図参照)。
そしてcsvとして書き出すときにB列とC列だけを書き出したい場合どのようにすればよいでしょうか。
この場合、書き出すときにA列だけを一旦削除、などということはしたくないです。
また1列目のタイトルも書き出さないようにしたいです。
ご教授よろしくお願いいたします。

Aベストアンサー

#2です。非連続な列群を指定した場合に対応させてみました。ご参考まで。
Unionに各範囲を与えるところは、ご自分でお願いします。
Sub test()
Dim targetRange As Range, myArea As Range, myColumn As Range
Dim i As Long, j As Long, columnCount As Long
Dim buf As Variant, buf2 As String
Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
Set targetRange = Union(Range("a1:a3"), Range("c1:d3"), Range("f1:f3"))
'データチェック 先頭行位置、行数の一致チェック 必要ならご自分で作成下さい。
'If Not checkRanges(targetRange) Then Exit Sub
For Each myArea In targetRange.Areas
columnCount = columnCount + myArea.Columns.Count
Next myArea
With FSO.createTextFile("C:\Sample.txt", True) 'overwrite
For i = 1 To targetRange.Areas(1).Rows.Count
ReDim buf(1 To columnCount)
j = 1
For Each myArea In targetRange.Areas
For Each myColumn In myArea.Columns
buf(j) = myColumn.Cells(i).Text 'Value
j = j + 1
Next myColumn
Next myArea
buf2 = Join(buf, ",")
.writeline buf2
Next i
.Close
End With
End Sub

#2です。非連続な列群を指定した場合に対応させてみました。ご参考まで。
Unionに各範囲を与えるところは、ご自分でお願いします。
Sub test()
Dim targetRange As Range, myArea As Range, myColumn As Range
Dim i As Long, j As Long, columnCount As Long
Dim buf As Variant, buf2 As String
Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
Set targetRange = Union(Range("a1:a3"), Range("c1:d3"), Range("f1:f3"))
'データチェック 先頭行...続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

Q【VBA ・ エクセル】 テキストファイルから特定情報をぬきだすには

下記のようなテキストファイルから、山田太郎の後ろの数値のみを、エクセルのシートに抜き出すにはどのようにしたらよいのでしょうか。

A1セルに30、A2セルに40、A3セルに60、のように入力したいです。よろしくおねがいします。

山田太郎 30点
aaaaaa30aaaaaaaaaaa
bbbbbb20bbbbbbbbbbb
ccccccccccccccccccc
山田太郎 40点
ssssss30sssssss
eeeeeee40eeeeeeeeee
fffffffffffffffffffffff
山田太郎 60点

Aベストアンサー

例データ
山田太郎 30点
aaaaaa30aaaaaaaaaaa
bbbbbb20bbbbbbbbbbb
ccccccccccccccccccc
山田太郎 40点
ssssss30sssssss
eeeeeee40eeeeeeeeee
fffffffffffffffffffffff
山田太郎 60点
これをメモ帳に貼り付け、名前をtest7.txtで保存しました。名前は自由です。
エクセルのVBEに標準モジュールに
Sub test01()
s = "山田太郎"
i = 2
Open "C:\Documents and Settings\XXXX\My Documents\test7.txt" For Input As #1
While Not EOF(1)
Line Input #1, a
If Left(a, Len(s)) = s Then
Cells(i, "A") = s
Cells(i, "B") = Right(a, Len(a) - Len(s))
i = i + 1
End If
Wend
Close #1
End Sub
を貼り付け、実行しました。
アクチブシートに
A列  B列
山田太郎 30点
山田太郎 40点
山田太郎 60点
となりました。

例データ
山田太郎 30点
aaaaaa30aaaaaaaaaaa
bbbbbb20bbbbbbbbbbb
ccccccccccccccccccc
山田太郎 40点
ssssss30sssssss
eeeeeee40eeeeeeeeee
fffffffffffffffffffffff
山田太郎 60点
これをメモ帳に貼り付け、名前をtest7.txtで保存しました。名前は自由です。
エクセルのVBEに標準モジュールに
Sub test01()
s = "山田太郎"
i = 2
Open "C:\Documents and Settings\XXXX\My Documents\test7.txt" For Input As #1
While Not EOF(1)
Line Input #1, a
If Left(a, Len(s)) = s ...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報