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

質問です
A列でA1から文字列があります
@を含まないデータの行を削除したい

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

▽最新の回答へ

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

過去の質問と同様の前提条件と想定し、Excelマクロ(VBA)を作ってみました。
お試しください。

前提条件

  1. ディレクトリ "C:/test/" 以下にある複数のCSVファイルが対象。
  2. CSVファイルにはA列しかない。

プログラムメモ

  1. 置換対象となった行は [LOG]シートに記録されます。A列がパス名、B列がファイル名、C列が置換した行番号です。
  2. 関数 hogeConv("C:/test/", "csv", "@") の3つめの引数を変更すると、カウントする文字列を変更することが出来ます。

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


'str1の中にstr2が含まれている個数
Function countStr(str1 As String, str2 As String) As String
 Dim cnt As Long
 Dim idx As Long
 
 cnt = 0
 idx = 1
 Do
 idx = InStr(idx, str1, str2)
 If (idx > 0) Then
 cnt = cnt + 1
 idx = idx + 1
 End If
 Loop While (idx <> 0)
 
 countStr = cnt
End Function

'1行処理
Function convRow(sour As String, ln As Long, path As String, fname As String, str As String) As String
 If (countStr(sour, str) <> 1) Then sour = ""
  'ログシートに書き出す
 If (sour = "") Then Call putLog(path, fname, ln)
 convRow = sour
End Function

'1ファイル処理
Sub convFile(path As String, fname As String, str 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)
 Line Input #1, buf
 buf = convRow(buf, ln, path, fname, str)
 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, str 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, str)
 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, str)
 Next flist
 End With
 Set re = Nothing
 Set fcol = Nothing
End Sub

Sub main()
 Call makeLogSheet
 Call hogeConv("C:/test/", "csv", "@")
End Sub

inosisiさんのコメント
ありがとうございます 上手くいきました また何かありましたら質問します
関連質問

●質問をもっと探す●



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