質問です

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

回答の条件
  • 1人3回まで
  • 登録:
  • 終了:2012/02/17 18:16:19
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:oil999 No.1

回答回数1728ベストアンサー獲得回数320

ポイント100pt

過去の質問と同様の前提条件と想定し、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
id:inosisi4141

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

2012/02/17 17:40:29
  • id:inosisi4141
    追加で@が2個以上ある行も削除できる関数をお願いします
    合わせて@がない行も削除できる関数となります
  • id:ken3memo
    B列など、どこかの列に
    http://www.eurus.dti.ne.jp/yoneyama/Excel/waza/mojiretu01.html#tokuteimojisuu
    みたいに@を数える式を入れて、
    フィルターなどで、1以外(0は無しだし、2,3,4..個は複数なので)、1以外を消すとか?※逆に1を選択して別シートにコピーするとか?
    テストしていないので、コメントで失礼します。



  • id:inosisi4141
    ken3memoさん
    関数を作って実際やりました
    上手くいきましたありがとうございます
    また何か質問がありましたらお願いします
  • id:inosisi4141
    ken3memoさん
    ポイント差し上げたいので解答欄でお願いします
  • id:ken3memo
    コードを書いたわけじゃないので(コメントなので)ポイントは、気にしないで、質問を終了させてOKです。
    ではまた?
  • id:inosisi4141
    ken3memoさん
    ではお言葉にあまえて終了させていただきます
    ではまた何かありましたら質問させていただきます

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

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

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

回答リクエストを送信したユーザーはいません