質問です

c:\test\の中に複数のCSVファイルがあります
データは2行目からでF列に1から12までの複数の数字のデータがあります
このデータの中にこれ以外のデータが含まれる場合にsheet1にログを
ファイル名、行番号表示するマクロをお願いします(CSVファイルは複数連続でマクロ)
ちなみに
データはA列からS列まであります
A列とG列には頭に0が含まれる文字列が含まれます
1行目は項目です

たとえば
1
1
11
12
4
4
8
1aaa
10bbb
の場合
1aaa
10bbb
のデータが該当します

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2012/02/21 13:25:58
  • 終了:2012/02/21 19:02:12

ベストアンサー

id:oil999 No.1

oil999回答回数1728ベストアンサー獲得回数3202012/02/21 17:20:07

ポイント100pt

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

ログは、[Sheet1]のA列にディレクトリ名、B列にファイル名、C列に行番号を記録します。
ご質問およびコメントの条件以外にも、F列がない場合にログに記録するようにしてあります。

Option Explicit

Private logSheet As String
Private logRow As Long

'ログシート作成
Private Sub makeLogSheet()
    Dim ws As Worksheet
    Dim flag As Boolean
    
    logSheet = "Sheet1"
    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 convRow(sour As String, ln As Long, path As String, fname As String) As String
    Dim items() As String
    items = Split(sour, ",")
   
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    With re
        .Pattern = "^[1-9][0-9]?$"
        .IgnoreCase = True
        .Global = True
    End With
    
    'F列があるかどうか
    If (UBound(items) < 5) Then
        Call putLog(path, fname, ln)
    '数字かどうか
    ElseIf (re.test(items(5)) = False) Then
        Call putLog(path, fname, ln)
    '1以上12以下かどうか
    ElseIf (items(5) < 1 Or items(5) > 12) Then
        Call putLog(path, fname, ln)
    End If
    Set re = Nothing
    
    convRow = sour
End Function

'1ファイル処理
Sub convFile(path As String, fname As String)
    Dim ln As Long
    Dim buf As String
    Dim fname1 As String
    fname1 = path & fname
    Open fname1 For Input As #1
    ln = 1
    Do Until EOF(1)
        Line Input #1, buf
        buf = convRow(buf, ln, path, fname)
        ln = ln + 1
    Loop
    Close #1
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

ありがとうございます
1行目は項目ですのでデータは2行目からでおねがいします
1行目のデータエラー表示がでているみたいです
よろしくお願いします

2012/02/21 18:34:30
id:oil999

>1行目は項目ですのでデータは2行目からでおねがいします

convFileを以下のものに差し替えてください。

---------------------
'1ファイル処理
Sub convFile(path As String, fname As String)
Dim ln As Long
Dim buf As String
Dim fname1 As String
fname1 = path & fname
Open fname1 For Input As #1
Line Input #1, buf
ln = 2
Do Until EOF(1)
Line Input #1, buf
buf = convRow(buf, ln, path, fname)
ln = ln + 1
Loop
Close #1
End Sub
---------------------

2012/02/21 19:18:05
  • id:inosisi4141
    頭に0が付く文字データは
    090*******の電話番号
    などです
  • id:inosisi4141
    入っている必要な数字データは

    1から12までの整数のみです

    1 2 3 4 5 6 7 8 9 10 11 12 

    この整数の前後になにかついていればログ出力します


    001はみなさないのでsheet1にログ出力ねがいます



  • id:inosisi4141
    従来のsheetにLOG表示のタイプでかまいません

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

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

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

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