• はてなアカウントでログイン
• 無料ユーザー登録

ベストアンサー

• kodairabase2012/01/12 21:08:38

  満足100pt

  回答コメントにしたがって修正しました。
  お試しください。
  
  A列しかないという条件で作りました。
  空白以外に置換したい文字があれば、mainの
  Call delHoge("C:/test/", "csv", "#")
  の3番目の引数で指定してください。2種類以上の文字を書くこともできます。

  Option Explicit
  
  '1列処理
  Function convCol(sour As String, str As String) As String
      Dim dest As String
      Dim re As Object
      Dim remat As Variant
      Dim pat As String
      dest = sour
      
      '指定文字削除
      If (str <> "") Then
          Set re = CreateObject("VBScript.RegExp")
          pat = "[" & str & "]+"
          With re
              .Pattern = pat
              .IgnoreCase = True
              .Global = True
          End With
          dest = re.Replace(dest, "")
          Set re = Nothing
      End If
  
      '@のあとに数字がある場合は行削除
      Set re = CreateObject("VBScript.RegExp")
      pat = "@[0-9０１２３４５６７８９]+"
      With re
          .Pattern = pat
          .IgnoreCase = True
          .Global = True
          Set remat = .Execute(dest)
          If remat.Count > 0 Then dest = ""
      End With
      Set re = Nothing
      
      convCol = dest
  End Function
  
  
  '1行処理
  Function convRow(buf As String, ln As Long, path As String, fname As String, str As String) As String
      Dim items As String, dest As String
      Dim ch As String
      
  '   items = Split(buf, ",")      '列に分解
      buf = Trim(buf)              '先頭・末尾の空白削除
      'クォーテーション削除
      ch = Left(buf, 1)
      If (ch = "'" Or ch = """") Then buf = Mid(buf, 2, Len(buf) - 2)
      '1列変換
      dest = convCol(buf, str)
      convRow = dest
  End Function
  
  '1ファイル処理
  Sub convFile(path As String, fname As String, str 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, str)
          If (buf <> "") Then Print #2, buf
          ln = ln + 1
      Loop
      Close #1
      Close #2
      Kill fname1                 'オリジナル・ファイル削除
      Name fname2 As fname1
  End Sub
  
  'ファイル探索＋処理実行
  Sub delHoge(path As String, ext As String, str 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 delHoge(path & flist.Name & "/", ext, str)
      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, str)
          Next flist
      End With
      Set re = Nothing
      Set fcol = Nothing
  End Sub
  
  Sub main()
      Call delHoge("C:/test/", "csv", "#")
  End Sub
  

  スター

  • 

    7件のコメントを見る

  • inosisi 2012/01/13 10:20:51

    ありがとうございます
    マクロ実行するとコンパイルエラー「SUBまたはFunctionが定義されてません」と出るのですが原因はなんでしょうか？
    それと質問ですがaaa@bbbの文字列の最後に半角または全角スペースを削除する、＠のあとの全角数字０から９まであった場合は行削除するはマクロに含まれていますか？
    
    A列のみでほかの列はありません

    スター

  • kodairabase 2012/01/13 13:51:39

    回答コメントにしたがって修正しました。
    お試しください。

    スター

  • inosisi 2012/01/13 15:57:45

    ありがとうございました
    上手くいきました。
    マクロの中をを良く見てなくてすみませんでした
    希望の処理は実行されていました
    追加で申し訳ないのですが
    @がついてないデータがまじっているのですが行削除できますか

    スター

  • kodairabase 2012/01/13 17:03:54

    ＞@がついてないデータがまじっているのですが行削除できますか
    convCol関数を以下のものに差し替えてください。
    

    '1列処理
    Function convCol(sour As String, str As String) As String
        Dim dest As String
        Dim re As Object
        Dim remat As Variant
        Dim pat As String
        dest = sour
        
        '指定文字削除
        If (str <> "") Then
            Set re = CreateObject("VBScript.RegExp")
            pat = "[" & str & "]+"
            With re
                .Pattern = pat
                .IgnoreCase = True
                .Global = True
            End With
            dest = re.Replace(dest, "")
            Set re = Nothing
        End If
    
        '@のあとに数字がある場合は行削除
        Set re = CreateObject("VBScript.RegExp")
        pat = "@[0-9０１２３４５６７８９]+"
        With re
            .Pattern = pat
            .IgnoreCase = True
            .Global = True
            Set remat = .Execute(dest)
            If remat.Count > 0 Then dest = ""
        End With
        Set re = Nothing
    
        '@がなければ行削除
        if (InStr(dest, "@") = 0) Then dest = ""
    
        convCol = dest
    End Function
    

    スター

  • inosisi 2012/01/14 19:09:59

    ありがとうございます
    いろいろご無理言ってすみませんでした
    助かりました

    スター

  • inosisi 2012/02/08 17:36:57

    Sub main()
    Call delHoge("C:/test/", "csv", "#")
    
    置換したい文字を複数追加したいのですができますか？
    たとえば""とか)とか今後置換したい文字がでてきても追加できるようにしたいのですがよろしくおねがいします

    スター

  • inosisi 2012/02/08 18:29:14

    最初に書いてありました
    複数できましたありがとうございました

    スター

その他の回答

この質問へのコメント

• inosisi2012/01/12 14:07:55
  半角および全角のスペース（空白）は文字の前にもあれば削除おねがいします
• inosisi2012/01/12 14:16:45
  文字のなかに＃があれば削除おねがいします
  削除したい文字が追加できる機能があれま助かります
  マクロの中に記述する方法でもＯＫです

質問の情報

登録日時

2012-01-12 14:04:55

終了日時

2012-01-13 16:37:31

回答条件

1人3回まで

この質問のカテゴリ

• コンピュータ
• インターネット

この質問に含まれるキーワード

人気の質問

• この英文どうなってますか？ The boy seemed to be waiting for his mother to come.（その少年は母親が来…匿名質問者112日前
• 不定詞の形容詞的用法らしいんですけど、副詞的用法と書いたら✖️ですか？ I want to buy a book to read …匿名質問者112日前
• 日向陽葵という○V女優が好きなのですが似ている○V女優はいますか匿名質問者20時間前
• 共通テストで使われるプログラミング言語は共通テスト特有の言語と聞いたのですが、受験勉強で身につけたプ…匿名質問者120時間前
• 内定してほしいポケモンはいますか？匿名質問者21時間前

メニュー

• 質問一覧
• カテゴリ一覧
• 無料ユーザー登録
• 人力検索はてなトップ

PC版

• お問い合わせ
• ヘルプ
• お知らせ
• はてなトップ