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

質問です
c:\test\の中にTAB切りのTXTファイルが複数あります
データはA列からs列まで
1行目は項目です
2行目からデータです
B列 09011112222
G列 09011112222
B列とG列は頭に0が付いた文字が含まれます
この0が取れないように
追加で空白のF列ができるマクロを作りたいのですが
結果F列が追加されA列からT列までとなります
よろしくお願いします
複数のtxtファイルは連続して実行できるようなマクロをお願いします

●質問者: inosisi
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● みかん
●5ポイント

テキストファイル1つにつき1つシート
TABファイルで保存する


inosisiさんのコメント
ありがとうございました

2 ● きゃづみぃ
●45ポイント ベストアンサー
Sub main()
Dim p As String
'対象フォルダを指定してください。
'このフォルダに この実行用のブックは 入れないでください。

p = "C:\test\"

'処理対象となる拡張子を指定して 呼び出します。
Call jikkou(p, "txt")

End Sub


Sub jikkou(p As String, s As String)

Dim bk() As String
Application.DisplayAlerts = False
 
f = Dir(p & "*." & s, vbNormal)

Do While f <> ""
 k = 0
 ReDim bk(k)
 
 ch1 = FreeFile
 Open p & f For Input As #ch1
 
 Do While Not EOF(ch1)  'ファイルの終端かどうかを確認します
 Line Input #ch1, textline  'データ行を読み込みます
 ReDim Preserve bk(k)
 bk(k) = textline
 k = k + 1
 Loop
 Close #ch1
 
 ch2 = FreeFile
 Open p & f For Output As #ch2
 For i = 0 To k - 1
 textline = bk(i)
 
 tabポイント = 1
 
 For dd = 1 To 5
 tabポイント = InStr(tabポイント, textline, vbTab) + 1
 Next dd
 
 Debug.Print textline
 g = Left(textline, tabポイント - 1) & vbTab
 textline = g & Right(textline, Len(textline) - tabポイント + 1)
 Debug.Print textline
 
 
 Print #ch2, textline  'データの書き込みをします
 Next i
 Close #ch2
 
 f = Dir
Loop

Application.DisplayAlerts = True

End Sub

項目数が足りない場合は、補いません。
あくまでも F列以上ある項目に対してF列を挿入するのみです。


inosisiさんのコメント
ありがとうございました うまくいきました

きゃづみぃさんのコメント
処理速度は 遅かったですか?

3 ● Silvanus
●55ポイント

これでいかがでしょうか。

Option Explicit

Sub inosisi4141()

Const Folder As String = "C:\test\"
Dim FileName As String

' 高速化が必要なら続く2行のアポストロフィを削除して下さい
' Application.ScreenUpdating = False
' Application.Calculation = xlCalculationAutomatic

FileName = Dir(Folder)

 Do While FileName <> ""
 Workbooks.OpenText FileName:=Folder & FileName, _
 DataType:=xlDelimited, ConsecutiveDelimiter:=False, _
 Tab:=True, FieldInfo:=Array(Array(1, 2), Array(2, 2), _
 Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), _
 Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), _
 Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), _
 Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), _
 Array(19, 2))
 ' FieldInfo の Array(X, Y) の意味
 ' X: 列番号 (A列 = 1, B列 = 2, ... , S列 = 19)
 ' Y: データ形式(XlColumnDataTypeクラス)
 ' 標準形式 = 1 (= xlGeneralFormat)
 ' 文字列形式 = 2 (= xlTextFormat)
 ' ※その他 略
 Columns("F:F").Insert Shift:=xlToRight
 Application.DisplayAlerts = False
 ActiveWorkbook.SaveAs FileName:=Folder & FileName, _
 FileFormat:=xlText, CreateBackup:=False
 ActiveWorkbook.Close SaveChanges:=False
 Application.DisplayAlerts = True
 FileName = Dir()
 Loop

' 高速化が必要なら続く2行のアポストロフィを削除して下さい
' Application.ScreenUpdating = True
' Application.Calculation = xlCalculationManual

End Sub

Silvanusさんのコメント
済みません…orz。 ' Application.Calculation = xlCalculationAutomatic の行と ' Application.Calculation = xlCalculationManual の行が逆でした…。

inosisiさんのコメント
ありがとうございました うまくいきました 高速化の処理もありがとうございました
関連質問

●質問をもっと探す●



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