• ベストアンサー
  • 困ってます

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

  • 質問No.8808123
  • 閲覧数351
  • ありがとう数4
  • 気になる数0
  • 回答数3
  • コメント数0

お礼率 100% (4/4)

 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行以上の文書です。よろしくお願いします

質問者が選んだベストアンサー

  • 回答No.3
  • ベストアンサー

ベストアンサー率 66% (266/403)

失礼しました。
以下のコードは「文字か、数字かで判断する場合」で置き換えたものになります。
補足の問題点を修正いたしましたのでご確認お願いします。

結果の問題点
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
お礼コメント
mj888

お礼率 100% (4/4)

早速の修正版をありがとうございます。
使ってみました。完璧です。助かります~感謝申し上げます。

ご呈示頂いた、VBAは、私にはまだ解読できませんが、勉強して理解していきたいと思います。

本当にありがとうございました。m(_ _)m
投稿日時:2014/11/04 22:13

その他の回答 (全2件)

  • 回答No.2

ベストアンサー率 66% (266/403)

私も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
お礼コメント
mj888

お礼率 100% (4/4)

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

早速、ご呈示のVBAコードを「文字か、数字かで判断する場合」で、該当箇所を追加・差替えてテストしてみました。結果が以下の通りです。
_____________________________________
処理対象文の<処理前>
[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文字数だけ削除されていますが7行目だけは文字なのに10文字が削除されています。そこから以降の行は処理せずに最終行に飛んで削除処理して終わっています。

結果の問題点
1.7行目の文字を削除してしまった。
2.9行目から最終行の間の削除処理が行われていない。
以上の問題点が解決できればと願っております。お手数を掛けますが、また、お願いできればとおもいます。
宜しくお願いします。
投稿日時:2014/11/03 13:01
  • 回答No.1

ベストアンサー率 66% (266/403)

VBAでの回答ではありませんが・・・
もし2個目の時間部分を削除したいだけなら正規表現置換でいいのでは?

http://utils.ipentec.com/WebTextUtility/ReplaceText/
上記サイトの入力に対象の文章をコピーし、

置換パターン:
(\[[\d\:]+) \| [\d\:\] ]+(\w.+)

置換文字列:
$1] $2

を入力して置換実行をクリックしてください。
補足コメント
mj888

お礼率 100% (4/4)

回答ありがとうございます。折角の回答していただきましたが、対象文書が大きいのと他の文書などにも応用させたい為にも、やはりVBAプログラムでお願いしたいと思います。
投稿日時:2014/10/30 23:33
お礼コメント
mj888

お礼率 100% (4/4)

ご親切に回答していただきまして、本当にありがとうございました。感謝申し上げます。m(_ _)m
投稿日時:2014/10/31 07:38
結果を報告する
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,600万件のQ&Aを分析して最適な回答をご提案します。

関連するQ&A

その他の関連するQ&Aをキーワードで探す

ピックアップ

ページ先頭へ