Excel VBAでの記号削除

Question

いつもありがとうございます。

早速ですが、標題のとおり現在エクセルで管理している情報の整理を手作業で進めています。
対象データ数が膨大であるため、手作業では限界があるため、VBAを使って処理できないかと
考えております。

工程としては以下のとおりです。
１．"名称"の文字を含むセル以外を削除
２．「半角英数字」の文字列を削除
３．「記号」を削除
４．空白行を削除

■例 --------------------------------------------------------------------------------
＜Sheet2!A:A＞処理前A1: <div id="name">苗字　名前</div>
A2: <div id="age">20</div>
A3: <div id="address">東京都</div>
↓
＜Sheet2!A:A＞処理後A1: 苗字　名前
A2:
A3: 東京都

※例のとおり、HTMLのソースをエクセルで貼り付けており、情報だけを抽出したいと考えております。

Webサイトを参考にして、工程1・2は実現できたのですが、3・4については参考となる情報を見つけられず。
また、VBA自体初心者であるため各工程ごとにボタンを設けて１つずつ実行する処理としています。

コードを教えてほしいという姿勢で、恐れ入りますがご教示いただけますと幸いです。
どうぞよろしくお願い致します。

Comments

[ttyp03]

要は名前だけ抽出できればよいのでしょうか？

[skygo]

ご返信ありがとうございます。例が分かりづらく申し訳ございません。「名前」タグの他にも、別のセルに全角文字の値があり、シート内のすべての全角文字はそのまま残したいと考えております。

[otn]

半角文字を全部削除したいということでしょうか？

[skygo]

ご返信ありがとうございます。仰せのとおり、半角文字（記号含む）をすべて削除したいのですが、思いとおりに動作しません。質問に記載した工程２の処理で英数字は削除できたのですが、記号（<,",/など）が残ってしまう状態となっております。恐れ入りますが、どうぞよろしくお願い致します。

Answer 1

正規表現で書いてみました。
仮に100行分処理するようにしてあります。
行数は適宜修正してください。
各行から全角文字以外を削除後、空行を削除します。
"シート名"のところも適宜修正してください。

Sub test()
    Set reg = CreateObject("VBscript.RegExp")
    Set sh = Worksheets("シート名") 

    With reg
        .Pattern = "[\x01-\x7E\xA1-\xDF]"
        .IgnoreCase = False
        .Global = True
    End With
    
    ' 全角以外を削除
    For r = 1 To 100
        sh.Cells(r, 1) = reg.Replace(sh.Cells(r, 1), "")
    Next
    
    ' 空行削除
    For r = 100 To 1 Step -1
        If sh.Cells(r, 1) = "" Then
            sh.Cells(r, 1).EntireRow.Delete
        End If
    Next
    
    Set reg = Nothing
    
End Sub

追記
質問クローズ後の修正で申し訳ありません。
用途は作業の効率化・単純化であってこのコード自体の効率化は関係ないと思いますが、個人的に気になったので少しだけ修正させてください。
ループは１回で済みそうなので、改良版を載せておきます。

Sub test()
    Set reg = CreateObject("VBscript.RegExp")
    Set sh = Worksheets("シート名") 

    With reg
        .Pattern = "[\x01-\x7E\xA1-\xDF]"
        .IgnoreCase = False
        .Global = True
    End With
    
    For r = 100 To 1 Step -1
        ' 全角以外を削除
        sh.Cells(r, 1) = reg.Replace(sh.Cells(r, 1), "")
        ' 空行なら削除
        If sh.Cells(r, 1) = "" Then
            sh.Cells(r, 1).EntireRow.Delete
        End If
    Next
    
    Set reg = Nothing
    
End Sub

Comments

[skygo]

ご回答ありがとうございます！
早急にご連絡いただいて、感謝いたします。

まだ試せてないのですが、bottun1クリック時に処理したいのですが、クリアする対象シートの指定などはどこかで設定するものでしょうか。

度々の質問で申し訳ございません。
行数は"1000"で動かしてみようかと思います！

[ttyp03]

回答したコードは、対象シートのコードで動く前提なので、特定のシートにしたいのであれば、シート名の指定が必要です。
このあと回答の方修正しますので、参考にしてください。

[skygo]

>ttyp03さま

度々のご回答まことにありがとうございます。
厚かましく要望を出してしまい申し訳ございませんでした。

ご案内頂いたコードで、ご指定の箇所を変更するだけで処置が完了しました！
本当にありがとうございました。
膨大なレコード数なのでどうしようかと困っていましたが、おかげ様でだいぶ時間を削減できます。

恐れ入りますが、今後ともどうぞよろしくお願い致します。
ありがとうございました。

[skygo]

>ttyp03さま
コメントを追加頂きましてありがとうございます。
いろいろとご考慮頂きまして、感謝いたします。

頂いた情報についても動作確認してみて参考にさせて頂きます。
ありがとうございました！

以上です。