質問です。

\test\のホルダーの中にCSVの拡張子がついたファイルが複数あります。
データはA列でA1からあります。

データ例1
aaa@0bbb
abc@1ccc
bca@8aaa
cba@11bbb
bbc@01_ss
のように@のつぎに数字がある場合のデータ行を削除

aaa@a11
bbb@ab012
のように@の後に数字がないデータの場合は削除しない

データ例2
,カンマが含まれるデータ行を削除
aaa,bbb

以上の2つの条件に該当するデータ行を削除するマクロをお願いします。
\test\の中の複数あるCSVファイルは連続して実行できること。

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2012/01/05 16:28:58
  • 終了:2012/01/05 18:33:20

ベストアンサー

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982012/01/05 17:17:57

ポイント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 Workbook
Dim gg As Long
Application.DisplayAlerts = False

Dim fdb() As String
    
a = 1
f = Dir(p & "*." & s, vbNormal)
Do While f <> ""
    ReDim Preserve fdb(a)
    fdb(a - 1) = f
    a = a + 1
    f = Dir
Loop


For aaa = 0 To a - 2
    f = fdb(aaa)
    csvout (p & f)
Next aaa

Application.DisplayAlerts = True

End Sub


Sub csvout(csFName As String)

    
    Dim FNo As Integer
    
    Dim wsObj As Worksheet
    
    Dim strGet As String
    
    Dim lRowCnt As Long
    
    Dim i As Long
    Dim outdata() As String
    
    
    FNo = FreeFile
    
    If Dir(csFName) <> "" Then
    
        Open csFName For Input As #FNo
      
        lRowCnt = 1
        
        Do Until EOF(FNo)
            no_out = 0
            Line Input #FNo, strGet
            
            f = 0
            For b = 1 To Len(strGet) - 1
                If Mid(strGet, b, 1) = """" Then
                    If f = 1 Then
                        f = 0
                    Else
                        f = 1
                    End If
                End If
                
                If Mid(strGet, b, 1) = "," Then
                    If f = 1 Then
                        'ダブルクオーテションの中で カンマありは 出力しない
                        no_out = 1
                    End If
                    Exit For
                End If
                
                If Mid(strGet, b, 1) = "@" Then
                    d = Mid(strGet, b + 1, 1)
                    If d >= "0" And d <= "9" Then
                        no_out = 1
                        Exit For
                    End If
                End If
            Next b
            
            If no_out = 0 Then
                ReDim Preserve outdata(lRowCnt)
                outdata(lRowCnt) = strGet
                lRowCnt = lRowCnt + 1
            End If
        Loop
        
        Close #FNo
        
        FNo = FreeFile
        Open csFName & "$$$" For Output As #FNo
        For b = 1 To lRowCnt - 1
                Print #FNo, outdata(b)
        Next b
        Close #FNo
    
        Kill csFName    'オリジナル・ファイル削除
        Name csFName & "$$$" As csFName
    
    End If
End Sub
id:inosisi4141

ありがとうございます
これでデータエラーは解消すると思いますが
また何かエラーがでましたら質問させていただきます。

2012/01/05 18:37:35

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

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

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

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