質問: excelのマクロは少しかじっていますが、word vbaは全くの初心者です。宜しくお願いします。 例えば、下のように、似かよった文面が複数行ある文書で [8:50:31] qqe-CF: The building where Q-ty’s friend lives is very old. [8:50:53] qqe-CF: The town where my father grew up is small. [8:51:40 | 8:52:14] qqe-CF: That is the school where Q-rex teaches. [8:52:44] qqe-CF: That is the room where I keep my books. [8:53:59 | 8:54:14] qqe-CF: This is a picture of the place where we are going for our holidays. [8:54:33] qqe-CF: This is the place where I fell off my bike. [8:54:52] qqe-CF: That is the place where we stayed for our honeymoon. ↑ここの左端から半角10文字目から始まる、半角10文字で、それが数字の場合(3行目の「 8:52:14」など)のみを、指定した複数行に渡り、数字か文字かを判別しながら自動で繰り返し削除するVBAマクロのプログラムを教えて下さい。 質問内容のまとめ 1.各行の、左端から半角10文字目から始まる半角10文字を削除対象とする。 2.数字のみを削除対象とし、文字はスルーする。 3.操作範囲行を指定できるようにする。1行から1000行の範囲で。 実際には、1000行以上の文書です。よろしくお願いします
回答: 失礼しました。 以下のコードは「文字か、数字かで判断する場合」で置き換えたものになります。 補足の問題点を修正いたしましたのでご確認お願いします。 結果の問題点 1.7行目の文字を削除してしまった。 → 削除処理判定flagが正常に行われていなかったため修正しました。 2.9行目から最終行の間の削除処理が行われていない。 → "["から8文字シフトした後、行末までの文字数が10文字無い場合に 次の行を跨ぎ処理をしていましたので修正しました。 → 末尾まで10文字確保できない場合『[8:31:25 | 8:31:2』などはスキップされます。 気になること・・・ 補足にてご提示の元の文面には以下の統一性がありません。 「を編集しました」と「編集しました」や「]」の有無など行によって結果が異なります。 現在の処理は"["を検索した位置より8文字右へシフトしたところから10文字を抜出し 抜き出した文字が特定文字「数値, ,:,/」であれば削除、それ以外ではればそのまま。 8文字シフトした位置から末尾までで10文字取得できなければ次の"["を検索・・・ としております。 ■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 Dim i As Integer '検索文字を指定 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) '末尾までの対象文字を10文字分取得可能か判定 Selection.EndKey Unit:=wdLine, Extend:=wdExtend If Len(Selection) - 9 < 10 Then flag = False Else '文字列の取得 Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.MoveRight Unit:=wdCharacter, Count:=8 Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend lVal = Selection flag = True End If End If '開始位置ならループ終了 If a = aa And p = pp Then Exit Do '末尾まで10文字確保できない場合は処理をスキップ If flag Then '文字を取得して判定 For i = 1 To Len(lVal) cVal = Mid(lVal, i, 1) If IsNumeric(cVal) Then '数値の場合 flag = True Else '文字の場合 If cVal = ":" Or cVal = "|" Or cVal = " " Then flag = True Else flag = False End If End If If flag = False Then Exit For Next i '対象文字の削除 If flag Then Selection.Delete Unit:=wdCharacter flag = False End If End If '初期位置を記録 If a = "" Then a = aa: p = pp '検索位置をシフト .Parent.Move Count:=1 End With DoEvents Loop Application.ScreenUpdating = True Selection.Find.ClearFormatting End Sub