質問です

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

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2012/10/09 18:29:27
  • 終了:2012/10/10 12:02:18

ベストアンサー

id:taknt No.2

きゃづみぃ回答回数13538ベストアンサー獲得回数11982012/10/09 21:00:59

ポイント45pt
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列を挿入するのみです。

id:inosisi4141

ありがとうございました
うまくいきました

2012/10/10 11:59:45
id:taknt

処理速度は 遅かったですか?

2012/10/10 20:27:22

その他の回答(2件)

id:sanada33 No.1

みかん回答回数293ベストアンサー獲得回数32012/10/09 19:45:22

ポイント5pt

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

id:inosisi4141

ありがとうございました

2012/10/10 11:56:40
id:taknt No.2

きゃづみぃ回答回数13538ベストアンサー獲得回数11982012/10/09 21:00:59ここでベストアンサー

ポイント45pt
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列を挿入するのみです。

id:inosisi4141

ありがとうございました
うまくいきました

2012/10/10 11:59:45
id:taknt

処理速度は 遅かったですか?

2012/10/10 20:27:22
id:Silvanus No.3

Silvanus回答回数174ベストアンサー獲得回数672012/10/10 06:15:54

ポイント55pt

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

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
id:Silvanus

済みません…orz。
' Application.Calculation = xlCalculationAutomatic
の行と
' Application.Calculation = xlCalculationManual
の行が逆でした…。

2012/10/10 06:30:17
id:inosisi4141

ありがとうございました
うまくいきました
高速化の処理もありがとうございました

2012/10/10 12:00:34
  • id:Silvanus
    複数のテキストファイルを1つのシートに読み込んで統合するのですか?
    それとも、1つのテキストファイルに付き、1つのシートを作成するのですか?
    数字のゼロが先頭に来る文字列をセルに読み込んだ際に
    先頭のゼロを消えない様にするには
    (1) 文字列を格納するセルの書式を事前に「文字列」に設定しておく
    (2) 格納する文字列の先頭(ゼロの前)にアポストロフィ(')を付加しておく
    等の方法があります。何れにしましても、新たに列を設ける必要はありません。
  • id:inosisi4141
    1つのテキストファイルに付き、1つのシートを作成します
    ファイル名ごとに連続で完結していきます

    作業の目的はE列のあとにF列(空白)を追加したい

    追加した際に0が無くならないこと

    txt(TAB)ファイルで保存する

    よろしくお願いします
  • id:inosisi4141
    作業前
    A  B C D E  F  G H I J K L M N O P Q R S
             


    作業後
    A B C D E  F  G  H I J K L M N O P Q R S T
            

    作業前にあったF列のデータはF列を追加したため1列ずれてG列に
    なります
  • id:Silvanus
    質問文を変な風に解釈してました…orz。
    「この0が取れないように(改行)追加で空白のF列ができるマクロを作りたい」
    の部分を
    「この0が取れないように"するために"空白のF列を"追加する"マクロを作りたい」
    の意味にとっていました。済みません…。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません