Word文書の途中の文字を判別して消すVBA

質問

• Excelのマクロは少しかじっていますが、Word VBAは全くの初心者です。指定した複数行に渡り、数字か文字かを判別しながら自動で繰り返し削除するVBAマクロのプログラムを教えてください。
• 質問内容のまとめ：1. 各行の左端から10文字目から始まる半角10文字を削除対象とする。2. 数字のみを削除対象とし、文字はスルーする。3. 操作範囲行を指定できるようにする。1行から1000行の範囲で。
• Word文書の途中の文字を判別して自動で削除するVBAマクロのプログラムを教えてください。Excelのマクロは少し使ったことがありますが、Word VBAは初心者です。指定した複数行に渡り、数字か文字かを判別しながら繰り返し削除する方法を知りたいです。

回答No.2

eden3616

私もVBAはエクセル程度しか扱っていないので、
Word VBAは素人ですが作成してみました。

カーソル位置をMoveRightやMoveDownで確実に
各先頭行からn文字と指定することも出来ますが
複数行にわたる文面に対する処理を不要にする事と、
処理速度を考慮して"["を検索した位置を基準としています。

■判定方法について
[8:51:40 | 8:52:14] qqe-CF: That is the school where Q-rex teaches.
コード簡略化のため、Likeにより上記の場合の判定部分『 | 8:52:14』が『 |*:*:*』に一致するかで判定しています。
ご質問内容のように文字か、数字かで判断する場合は以下の箇所を追加・差替えてください。

'変数を宣言【同コメント内の最後に追加】
dim i As Integer

'文字列の取得 【同コメント内を全差替え】
Selection.MoveRight Unit:=wdCharacter, Count:=8
Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend
lVal = Selection

'文字を取得して判定 【同コメント内を全差替え】
For i = 1 To Len(lVal)
　　cVal = Mid(lVal, i, 1)
　　If VarType(cVal) = vbDouble Then
　　　　'数値の場合
　　　　flag = True
　　Else
　　　　'文字の場合
　　　　If cVal = ":" Or cVal = "|" Or cVal = " " Then flag = True
　　End If
　　If flag = False Then Exit For
Next i

'対象文字の削除【同コメント内を全差替え】
If flag Then
　　Selection.Delete Unit:=wdCharacter
　　flag = False
End If

■VBAコード

Sub sample()
'変数を宣言
Dim lmoji As String, lVal As String, cVal As String
Dim aa As String, pp As String, a As String, p As String
Dim flag As Boolean

　　'検索文字を指定
　　lmoji = "["
　　'カーソルを先頭へ
　　Selection.HomeKey Unit:=wdStory
　　Application.ScreenUpdating = False
　　'メイン処理
　　Do
　　　　'検索条件を設定
　　　　With Selection.Find
　　　　　　.Forward = True
　　　　　　.ClearFormatting
　　　　　　.MatchWholeWord = True
　　　　　　.MatchCase = False
　　　　　　.Wrap = wdFindContinue
　　　　　　'lmojiを検索
　　　　　　If .Execute(FindText:=lmoji, Forward:=True, Format:=True) = True Then
　　　　　　　　'行、頁位置を取得
　　　　　　　　aa = Selection.Information(wdFirstCharacterLineNumber)
　　　　　　　　pp = Selection.Information(wdActiveEndPageNumber)
　　　　　　　　'文字列の取得
　　　　　　　　Selection.EndKey Unit:=wdLine, Extend:=wdExtend
　　　　　　　　lVal = Selection.Text
　　　　　　End If
　　　　　　'開始位置ならループ終了
　　　　　　If a = aa And p = pp Then Exit Do
　　　　　　'文字を取得して判定
　　　　　　If Mid(lVal, 9, 10) Like " |*:*:*" Then flag = True
　　　　　　'対象文字の削除
　　　　　　If flag Then
　　　　　　　　Selection = Replace(lVal, Mid(lVal, 9, 10), "")
　　　　　　　　flag = False
　　　　　　End If
　　　　　　'初期位置を記録
　　　　　　If a = "" Then a = aa: p = pp
　　　　　　'検索位置をシフト
　　　　　　.Parent.Move Count:=2
　　　　End With
　　　　DoEvents
　　Loop
　　Application.ScreenUpdating = True
　　Selection.Find.ClearFormatting
End Sub

お礼

eden3616さん
ご丁寧に回答いただきましてありがとうございます。感謝申し上げます。

早速、ご呈示のＶＢＡコードを「文字か、数字かで判断する場合」で、該当箇所を追加・差替えてテストしてみました。結果が以下の通りです。
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
処理対象文の＜処理前＞
[8:31:32 | 8:31:59を編集しました] qqe-CF: What do you think . . .
[8:31:25 | 8:31:27を編集しました] qqe-CF: I recommend you . .
[8:31:25 | 8:31:27を編集しました] qqe-CF: I recommend you . .

[8:31:25を編集しました] qqe-CF: I recommend you . .
[8:31:26 | 8:31:59を編集しました] qqe-CF: What do you think . . .
[8:42:27 qqe-CF: What do you think of the book?
[8:31:28 | 8:31:27を編集しました] qqe-CF: I recommend you . .
[8:31:32を編集しました] qqe-CF: What do you think . . .
[8:42:33qqe-CF: What do you think of the book?
[8:33:33を編集しました]
[8:31:34 | 8:31:27を編集しました] qqe-CF: I recommend you . .
[8:31:34編集しました] qqe-CF: What do you think . . .
[8:42:34qqe-CF: What do you think of the book?
[8:33:35編集しました]
[8:31:16 | 8:31:27を編集しました] qqe-CF: I recommend you . .
[8:31:32を編集しました] qqe-CF: What do you think . . .
[8:33:17 | 8:33:51を編集しました]
＜処理後＞　　　↓↓↓
[8:31:32を編集しました] qqe-CF: What do you think . . .
[8:31:25を編集しました] qqe-CF: I recommend you . .
[8:31:25を編集しました] qqe-CF: I recommend you . .

[8:31:25を編集しました] qqe-CF: I recommend you . .
[8:31:26を編集しました] qqe-CF: What do you think . . .
[8:42:27hat do you think of the book?
[8:31:28を編集しました] qqe-CF: I recommend you . .
[8:31:32を編集しました] qqe-CF: What do you think . . .
[8:42:33qqe-CF: What do you think of the book?
[8:33:33を編集しました]
[8:31:34 | 8:31:27を編集しました] qqe-CF: I recommend you . .
[8:31:34編集しました] qqe-CF: What do you think . . .
[8:42:34qqe-CF: What do you think of the book?
[8:33:35編集しました]
[8:31:16 | 8:31:27を編集しました] qqe-CF: I recommend you . .
[8:31:32を編集しました] qqe-CF: What do you think . . .
[8:33:17を編集しました]
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
※4行目に空白行が入っています。
1行目～8行目までは、対象範囲の10文字数だけ削除されていますが７行目だけは文字なのに10文字が削除されています。そこから以降の行は処理せずに最終行に飛んで削除処理して終わっています。

結果の問題点
１．7行目の文字を削除してしまった。
２．9行目から最終行の間の削除処理が行われていない。
以上の問題点が解決できればと願っております。お手数を掛けますが、また、お願いできればとおもいます。
宜しくお願いします。