質問です

c:\test\のホルダーの中に複数のCSVファイルがあります
この中のデータは文字列でA列の1行目から複数あります
このデータの中で
90からはじまる10桁の数字があり11桁目は@です、そのあとにも文字があります
例  90********@aaaa
80からはじまる10桁の数字があり11桁目は@です、そのあとにも文字があります
例  80********@bbbb
以上の文字列の場合に限り文字の頭(行頭)に0(数字のゼロ)をつけたいのですが
答え
090********@aaaa
080********@bbbb
マクロでできますかよろしくおねがいします

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2012/02/02 13:51:10
  • 終了:2012/02/02 17:12:55

ベストアンサー

id:oil999 No.1

oil999回答回数1728ベストアンサー獲得回数3202012/02/02 16:07:46

ポイント100pt

数字10桁以外の場合は0付加しないようにしてあります。
お試しください。

Option Explicit

'1行処理
Function convRow(buf As String, ln As Long, path As String, fname As String) As String
    Dim re As Object
    Dim pat As String
    
    'パターンに応じて0付加
    Set re = CreateObject("VBScript.RegExp")
    pat = "^(""?)([0-9]{10}@)"
    With re
        .Pattern = pat
        .IgnoreCase = True
        .Global = True
    End With
    buf = re.Replace(buf, "$10$2")
    Set re = Nothing

    convRow = buf
End Function

'1ファイル処理
Sub convFile(path As String, fname As String)
    Dim ln As Long
    Dim buf As String
    Dim fname1 As String, fname2 As String
    fname1 = path & fname
    fname2 = path & fname & ".$$$"
    Open fname1 For Input As #1
    Open fname2 For Output As #2
    ln = 1
    Do Until EOF(1)
        Line Input #1, buf
        buf = convRow(buf, ln, path, fname)
        If (buf <> "") Then Print #2, buf
        ln = ln + 1
    Loop
    Close #1
    Close #2
    Kill fname1                 'オリジナル・ファイル削除
    Name fname2 As fname1
End Sub

'ファイル探索+処理実行
Sub hogeConv(path As String, ext As String)
    Dim fcol As Object, re As Object
    Dim flist As Variant, remat As Variant
    Dim pat As String
    'サブディレクトリ探索
    Set fcol = CreateObject("Scripting.FileSystemObject").GetFolder(path).SubFolders
    For Each flist In fcol
        Call hogeConv(path & flist.Name & "/", ext)
    Next flist
    Set fcol = Nothing
    '処理対象ファイル探索+処理実行
    Set fcol = CreateObject("Scripting.FileSystemObject").GetFolder(path).Files
    Set re = CreateObject("VBScript.RegExp")
    pat = "\." & ext & "$"
    With re
        .Pattern = pat
        .IgnoreCase = True
        .Global = True
        For Each flist In fcol
            Set remat = .Execute(flist.Name)
            If remat.Count > 0 Then Call convFile(path, flist.Name)
        Next flist
    End With
    Set re = Nothing
    Set fcol = Nothing
End Sub

Sub main()
    Call hogeConv("C:/test/", "csv")
End Sub
id:inosisi4141

ありがとうございました
試しましたら上手くゆきました。
本当に助かりました。

2012/02/02 17:12:44

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

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

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

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