質問です

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

その中の行のセルのいくつかにダブルコーテーションに囲まれた中に複数のデータがあるセルがあります
TXTでみると
"aaaa
bbbb
cccc
dddd
"
の状態になっています
そのセルがどのファイルにあるかわかりませんマクロで探してどのファイルのA列の何行目に
あるか実行ファイルのsheet1に表記できるマクロをおねがいします

ちなみにマクロでその中のセルのいくつかにダブルコーテーションに囲まれた複数のデータ
を行列にもどすことは可能でしょうか

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2012/02/08 19:31:24
  • 終了:2012/02/14 12:38:10

ベストアンサー

id:oil999 No.1

oil999回答回数1728ベストアンサー獲得回数3202012/02/09 01:05:16

ポイント100pt

以下のマクロをお試しください。

A列だけ存在するという前提です。
ご質問にあったイレギュラーなデータは分解して、CSVに収め直すようにしてあります。
また、イレギュラーなデータが見つかったら、シート"LOG"に残すようにしてあります。A列にディレクトリ、B列にファイル名、C列に行番号が入ります。

Option Explicit

Private logSheet As String
Private logRow As Long

'ログシート作成
Private Sub makeLogSheet()
    Dim ws As Worksheet
    Dim flag As Boolean
    
    logSheet = "LOG"
    flag = False
    For Each ws In Worksheets
        If ws.Name = logSheet Then flag = True
    Next ws
    If (flag = True) Then
        Worksheets(logSheet).Cells.Clear
    Else
        Set ws = Worksheets.Add
        ws.Name = logSheet
    End If
    logRow = 1
End Sub

'処理結果をログシートに残す
Private Sub putLog(path As String, fname As String, ln As Long)
    Worksheets(logSheet).Cells(logRow, 1) = path
    Worksheets(logSheet).Cells(logRow, 2) = fname
    Worksheets(logSheet).Cells(logRow, 3) = ln
    logRow = logRow + 1
End Sub

'1行処理
Function convRow2(sour As String, ln As Long, path As String, fname As String) As String
    Dim dest As String
    dest = Replace(sour, vbCrLf, """" & vbCrLf & """")
    dest = Replace(dest, vbCrLf & """""", "")
    'ログシートに書き出す
    If (sour <> dest) Then Call putLog(path, fname, ln)
    convRow2 = dest
End Function

'1行読み込み:イレギュラー対応版
Function hogeLineInput(n As Integer)
    Dim sour As String, dest As String, c As String, q As String
    Dim i As Long, ln As Long

    dest = ""
    If (EOF(n) = False) Then
        Do
            Line Input #n, sour
            ln = Len(sour)
            For i = 1 To ln
                c = Mid(sour, i, 1)
                'ダブルクォーテーション
                If (c = """") Then
                    If (q = "") Then
                        dest = """"    '最初のクォーテーションの前の文字は無視
                        q = """"
                    ElseIf (q = """") Then
                        dest = dest & c
                        q = ""
                        i = ln
                    End If
                Else
                    dest = dest & c
                End If
            Next i
            If q = """" Then dest = dest & vbCrLf
        Loop While (EOF(n) = False) And q = """"
    End If
    hogeLineInput = dest
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)
        buf = hogeLineInput(1)
        buf = convRow2(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 makeLogSheet
    Call hogeConv("C:/test/", "csv")
End Sub
id:inosisi4141

大変遅くなりました
身内に不幸があったものですから

ありがとうございました
上手くいきました何かありましたら質問させていただきます

2012/02/14 12:37:57

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

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

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

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