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

ベストアンサー

• きゃづみぃ2013/06/18 18:56:51

  満足100pt

  Sub main()
  Dim p As String
  '対象フォルダを指定してください。
  'このフォルダに この実行用のブックは 入れないでください。
  
  p = "C:\test\"
  
  '処理対象となる拡張子を指定して 呼び出します。
  Call jikkou(p, "csv")
  
  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
      moji = ""
      kk = 0
      Open p & f For Output As #ch2
      For i = 0 To k - 1
          textline = bk(i)
          If Trim(textline) <> "" Then
              kk = kk + 1
              If kk > 4 Then
                  Print #ch2, moji       'データの書き込みをします
                  moji = textline
                  kk = 1
              Else
                  If moji = "" Then
                      moji = textline
                  Else
                      moji = moji & "," & textline
                  End If
              End If
          End If
      Next i
      
      If moji <> "" Then
          Print #ch2, moji       'データの書き込みをします
      End If
        
      Close #ch2
   
      f = Dir
  Loop
  
  
  Application.DisplayAlerts = True
  
  End Sub
  
  
  

  スター

  • 

    14件のコメントを見る

  • inosisi 2013/06/19 13:09:23

    有難うございました。
    うまくいきました。
    助かりました。
    やっぱり
    
    空白行削除のあと
    
    《名称》
    《TEL》
    《〒》
    《住所》
    の4つを外して4つのカンマ区切りにする
    を一緒にできるとありがたいです
    
    追加で100ポイント差しあげます

    スター

  • きゃづみぃ 2013/06/19 13:37:21

    最初は それを削除するものを作ったんだけど よくよく読んでみたら ないようなので なくしちゃったんですよね。

    スター

  • きゃづみぃ 2013/06/19 13:41:09

    Sub main()
    Dim p As String
    '対象フォルダを指定してください。
    'このフォルダに この実行用のブックは 入れないでください。
    
    p = "C:\test\"
    
    '処理対象となる拡張子を指定して 呼び出します。
    Call jikkou(p, "csv")
    
    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
        moji = ""
        kk = 0
        Open p & f For Output As #ch2
        For i = 0 To k - 1
            textline = bk(i)
            If Trim(textline) <> "" Then
                kk = kk + 1
                textline = Replace(textline, "《名称》", "")
                textline = Replace(textline, "《TEL》", "")
                textline = Replace(textline, "《〒》", "")
                textline = Replace(textline, "《住所》", "")
                If kk > 4 Then
                    Print #ch2, moji       'データの書き込みをします
                    moji = textline
                    kk = 1
                Else
                    If moji = "" Then
                        moji = textline
                    Else
                        moji = moji & "," & textline
                    End If
                End If
            End If
        Next i
        
        If moji <> "" Then
            Print #ch2, moji       'データの書き込みをします
        End If
          
        Close #ch2
     
        f = Dir
    Loop
    
    
    Application.DisplayAlerts = True
    
    End Sub
    

    スター

  • inosisi 2013/06/19 14:13:35

    ありがとうがざいました。
    完璧です。
    手動で最初らるつもりでしたがこの方が断然速いです。
    助かりました。

    スター

  • inosisi 2013/06/19 14:16:22

    追加ポイントのやり方を忘れてしまいました。
    教えていただきたいのですが

    スター

  • きゃづみぃ 2013/06/19 14:27:51

    https://www.hatena.ne.jp/shop/point/sendpoint
    
    こちらから送信できます。

    スター

  • inosisi 2013/06/19 20:02:48

    追加100ポイントを差し上げますので下記条件でカンマ区切りになるように
    お願いします
    
    《名称》あああ
    《TEL》088-888-8888
    《〒》888-0088
    《住所》あああいいいい
    
    《名称》いいい
    《TEL》099-999-9999
    《〒》999-0099
    《住所》いいいうううう
    
    《名称》うううう
    《TEL》077-777-7777
    《〒》777-0077
    《住所》うううええええ
    
    1行目に空白行を設けても構いませんので
    空白行から空白行の間の4行のデータは必ず同じ行にカンマ区切りされるよう
    チェック願います
    名称の
    
    あああ
    いいい
    ううう
    
    はそれぞれ別物です

    スター

  • inosisi 2013/06/19 20:05:14

    処理後
    あああ,088-888-8888,888-0088,あああいいいい
    いいい,099-999-9999,999-0099,いいいうううう
    うううう,077-777-7777,777-0077,うううええええ
    
    に必ずなるようにお願いします
    これになる条件は空白行で分かれていることです

    スター

  • きゃづみぃ 2013/06/19 20:56:02

    最後のプログラムを実行して確認してみると 処理後の状態になります。
    
    問題となるパターンを あげてください。

    スター

  • inosisi 2013/06/20 10:00:30

    《名称》
    《TEL》
    《回線》
    《〒》
    《住所》
    のパターンがありました
    このパターンとの間のデータが崩れてしまっていますので
    《回線》の行を削除してマクロ実行するとＯＫでした
    《回線》の行がある場合その行を削除できますか？

    スター

  • きゃづみぃ 2013/06/20 11:59:40

    プログラムとしては 連続する4つを 接続するようにしています。
    《名称》
    《TEL》
    《〒》
    《住所》
    それぞれのワードをチェックして 連結するようにすれば いいかもしれませんね。

    スター

  • inosisi 2013/06/20 12:21:39

    ありがとうございました
    ソフトのほうで解決できましたので
    今後の参考にします。

    スター

  • きゃづみぃ 2013/06/21 14:10:13

    何かありましたら 別に質問だてしてもらったほうが わかりやすいかなと思います。

    スター

  • inosisi 2013/06/21 16:17:51

    ありがとうございました
    きゃづみぃさんにご紹介いただいたソフトで
    解決いたしました。ありがとうございました。
    また何かありもしたらよろしくお願いいたします。

    スター

その他の回答

• inosisi

  2013/06/18 18:27:00

  空白行は削除できます

  《名称》

  《TEL》

  《〒》

  《住所》

  は外せます

  データとしては

  あああ

  088-888-8888

  888-0088

  あああいいいい

  いいい

  099-999-9999

  999-0099

  いいいうううう

  うううう

  077-777-7777

  777-0077

  うううええええ

  の状態です

  よろしくお願いします

この質問へのコメント

質問の情報

登録日時

2013-06-18 17:54:36

終了日時

2013-06-19 13:09:58

回答条件

1人5回まで

この質問のカテゴリ

• ウェブ制作

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

人気の質問

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

メニュー

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

PC版

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