人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

質問です
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
のデータが該当します

●質問者: inosisi
●カテゴリ:コンピュータ インターネット
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● oil999
●100ポイント ベストアンサー

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

ログは、[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

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

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 ---------------------
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ