| |
はじめまして、vba初心者です。
数千のテキストデータ（アンケート）をエクセルの一つのシートに纏める作業をしていますが手作業でコピペをしているので大変時間がかかります。
ファイルの位置は固定です。
そこでマクロを使い一括で出来ないか考えていたところ、下記のコードに出会いました。
自分でも色々改変してみたのですが、さっぱりでした。
私がやりたいのはテキストファイル一つを1セルの中に入れることです。
テキスト1の内容をエクセルA1へ
テキスト2の内容をエクセルA2へ
テキスト3の内容をエクセルA3へ
このような形に変更するのはどこを修正すればよいのか教えていただければと思います。
よろしくお願いいたします。
-------------------------------------------------------------------
' テキストファイル一括読み込み
'
' ディレクトリ中の全てのテキストファイルを読み込みます。
' ファイル中の1行をワークシートの1列として、1ファイルを1行に収めます。
' メイルフォームから受け取ったような "=" で区切られた文字列を処理します。
'
' 本プログラムは GNU LGPL に拠り配布されるフリー･ソフトウェアです。
' GNU LGPL の条件に反しない限り、配布・変更は自由です。
'
' 無保証です。このソフトウェアの使用により生じたいかなる損害についても、
' 作者は責任を負いません｡
'
' Copyright: 1999, 魔術幻燈
' -------------------------------------------------------------------
Sub 階層まるごとテキスト読み込み()
Dim dir_name As String, file_name As String
Dim rn As Integer
dir_name = Application.GetOpenFilename( _
"テキストファイル (*.txt),*.txt", 1, _
"読み込み元のファイルをどれか一つ開いてください" _
)
If dir_name = "False" Then Exit Sub
file_name = Dir("*.txt", vbNormal)
rn = 1 ' 開始行 - 1 を設定
Do Until file_name = ""
rn = rn + 1
Call ImportText(file_name, rn)
file_name = Dir()
Loop
Application.StatusBar = "不要な文字列を削除しています。"
ActiveSheet.UsedRange.Replace _
what:="*=", Replacement:=""
Application.StatusBar = False
MsgBox dir_name & "が入っているディレクトリの内容を読み込みました。", 0, "メイル読み込み"
End Sub
Sub ImportText(file_name As String, rn As Integer)
Dim FileNum As Integer
Dim TextLine As String
Dim cn As Integer
FileNum = FreeFile()
Open file_name For Input Access Read As #FileNum
Application.StatusBar = "ファイル""" & file_name & """の内容を読み込んでいます。"
On Error GoTo CloseFile
Do Until EOF(FileNum)
Line Input #FileNum, TextLine
cn = cn + 1
Cells(rn, cn).Value = Trim(TextLine)
Loop
CloseFile:
Application.StatusBar = False
Close #FileNum
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
