« ユーザーフォームのテキストボックス内で改行文字列を取り出す(その3) | トップページ | マクロインストーラーの更新 »

2009年10月31日 (土)

Replace関数の例:右クリックでグーグルに活用してみた。

先週のコメントにてKonnoさんから教えていただいたReplace関数
を用いたプログラムです。

以下、ここ1年ほどの、私がつくってきた同じプログラムの改良の過程です。

2008年8月3日に公開した右クリックでグーグルのテンプレート
に掲載されていたプログラムを初代として、現在までに改良した
4世代を紹介します。(初代以降は、本日初公開)

当初、80行かけて書いていた「右クリックでグーグル_ワイルドカード検索」
ですが、いろんな学びをへて、今日書いたプログラムはたった4行です。

ご興味がある方、長いですが見比べてみてください。

無駄がたくさんあったプログラムが、ちょっとした知識で変わっていく
過程がみれますね。

自分でも成長を実感できてうれしいかぎりです。

Konnoさん、どうもありがとうございました。

ちなみに、処理スピードですが、体感スピードは全く変わりません。
それが、VBAの楽しいところですね。

ヘルプを活用して新しい関数を使って”高度な”プログラム
をかけなくても、基礎にのっとって、”エラーのない泥臭い”プログラムを
書けば、結果は同じことが得られるんですね。

パソコンの処理性能が上がったおかげで、このような状態なんだと
思います。

私たち初心者プログラマーにはうれしいことですね。

▼第4世代プログラム 2009年10月31日
ポイント Replace関数の利用(Split関数利用を中止)
Split関数で必要とされていた「半角スペースが選択されていない場合の
エラー処理」が不要になりました。
第3世代で省略した「全角スペース区切り文字列」へも対応します。

結果、25行→4行

Sub 第4世代_グーグル検索_ワイルドカード()

      Dim phrase As String    '複数の単語の塊
      Dim URL As String       '開きたいサイトのURL

      '抽出した単語から検索用のフレーズを作る(半角スペース区切り)
10    phrase = Replace(Selection.Range, " ", "+*+")

      '抽出した単語から検索用のフレーズを作る(全角スペース区切り)
20    phrase = Replace(phrase, " ", "+*+")

30    URL = "http://www.google.co.jp/search?q=%22" & phrase & "%22&lr="
40    ActiveDocument.FollowHyperlink address:=URL, AddHistory:=True

End Sub

▼第3世代プログラム 2009年7月26日
ポイント 100行のSplit関数、120行のUBound関数の利用
区切られた単語の数を数える必要がなくなったので、行数削減
半角スペースで区切られた文字列を検索するようにした
以前は対象としていた「全角スペース区切りの文字列の処理」は、
Split関数使用にあたり省略

結果、45行→25行へ

Sub 第3世代_グーグル検索_ワイルドカード()

      Dim phrase As String    '複数の単語の塊
      Dim URL As String       '開きたいサイトのURL
      Dim SS, SE As Long      '選択した文字列のカーソル位置
      Dim myRange As Range    'レンジオブジェクト
      Dim strWord() As String '半角スペースで区切られた文字列
      Dim i As Integer

10       On Error GoTo vct_グーグル検索_ワイルドカード_Error

20    SS = Selection.Start
30    SE = Selection.End

      'Rangeオブジェクトの設定
40    Set myRange = ActiveDocument.Range

      '選択範囲の最後が改行記号の場合の処理
50    myRange.SetRange Start:=SE - 1, End:=SE

60    If myRange = chr(13) Then
70        SE = SE - 1
80    End If

      '単語の検索(半角・全角スペース以外の文字列を検索します)
90    myRange.SetRange Start:=SS, End:=SE

      '選択したフレーズ中の単語を抽出
      '区切り文字を" "(半角スペース)に設定
100   strWord() = Split(myRange, " ")

      '抽出した単語から検索用のフレーズを作る
110   phrase = strWord(0)

120   For i = 1 To UBound(strWord)
130       phrase = phrase & "+*+" & strWord(i)
140   Next

150   URL = "http://www.google.co.jp/search?q=%22" & phrase & "%22&lr="
160   ActiveDocument.FollowHyperlink address:=URL, AddHistory:=True

170   Set myRange = Nothing

180      On Error GoTo 0
190      Exit Sub

vct_グーグル検索_ワイルドカード_Error:

200   If Err = 9 Then
210       phrase = vbNullString
220       End
230   Else
240       MSGBOX "エラーが発生したため終了します。" & Err
250   End If

End Sub

▼第2世代プログラム 2009年6月21日
ポイント Rangeオブジェクトを利用 考え方は、初代プログラムと同じ。
Selectionオブジェクトにくらべ、プログラム自体の不要な行数が減った。
また、検索ダイアログボックスを初期化する必要がなくなったので、
初代プログラムにあった670行~800行のコードが不要になった。
40行~70行は、選択下文字列の最後が改行マーク(vbCr)の場合の処理。

結果、80行→45行。

Sub 第2世代_グーグル検索_ワイルドカード()

      Dim phrase As String    '複数の単語の塊
      Dim URL As String       '開きたいサイトのURL
      Dim SS, SE As Long      '選択した文字列のカーソル位置
      Dim myRange As Range    'レンジオブジェクト

10    SS = Selection.Start
20    SE = Selection.End

      'Rangeオブジェクトの設定
30    Set myRange = ActiveDocument.Range

      '選択範囲の最後が改行記号の場合の処理
40    myRange.SetRange Start:=SE - 1, End:=SE

50    If myRange = Chr(13) Then
60        SE = SE - 1
70    End If

      '単語の検索(半角・全角スペース以外の文字列を検索します)
80    myRange.SetRange Start:=SS, End:=SS

90    With myRange.Find
100       .Text = "([!  ]{1,})"
110       .Forward = True
120       .Wrap = wdFindStop
130       .MatchByte = True
140       .MatchWildcards = True
150       .Execute
160   End With

      'スペースを選んだ場合はプログラム終了
170   If Not myRange.Find.Found Then
180       MsgBox "スペースで区切られた複数の単語を選択してください。"
190       End
200   End If

      '選択範囲の先頭に単語が含まれない場合にはプログラム終了
210   If myRange.Start <> SS Then
220       MsgBox "スペースで区切られた複数の単語を選択してください。"
230       End
240   End If

      '単語が見つかった場合には、見つかった単語を格納
250   If myRange.Find.Found = True Then phrase = myRange

      '二つめ以降の単語の検索

260   Do
          '次の単語の検索(半角、全角スペース以外の文字列を検索します)
270       myRange.SetRange Start:=myRange.End, End:=myRange.End
280       myRange.Find.Execute
         
290       If myRange.Find.Found = False Then
300           Exit Do
310       Else
              '末尾をそろえるための確認(日本語のとき役に立ちます)
320           If myRange.End > SE Then
330               myRange.End = SE
340           End If
             
350           If myRange.Start >= SE Then
360               Exit Do
370           Else
380               phrase = phrase & "+*+" & myRange
390               myRange.Collapse direction:=wdCollapseEnd
400           End If
410       End If

420   Loop

430   URL = "http://www.google.co.jp/search?q=%22" & phrase & "%22&lr="
440   ActiveDocument.FollowHyperlink address:=URL, AddHistory:=True

450   Set myRange = Nothing

End Sub

▼初代プログラム 2008年8月3日
ポイント Selectionオブジェクトにて、全ての処理を実施。
全角スペースまたは半角スペースで区切られた文字列を
一つずつSelectionで探し出して、フレーズを作っています。

Sub 初代_グーグル検索_ワイルドカード()

      Dim word As String      '選択された文字列内の単語ひとつずつ
      Dim Phrase As String    '複数の単語の塊
      Dim URL As String       '開きたいサイトのURL
      Dim SS, SE As Long          '選択した文字列の最終カレット位置

10    SS = Selection.Start
20    SE = Selection.End

      '最初の単語の検索

          '単語の検索(半角・全角スペース以外の文字列を検索します)
30        With Selection.Find
40            .Text = "([!  ]{1,})"
50            .Replacement.Text = ""
60            .Forward = True
70            .Wrap = wdFindStop
80            .Format = True
90            .MatchCase = False
100           .MatchWholeWord = False
110           .MatchByte = False
120           .MatchAllWordForms = False
130           .MatchSoundsLike = False
140           .MatchFuzzy = False
150           .MatchWildcards = True
160       End With
         
170       Selection.Find.Execute
         
          'スペースを選んだ場合はプログラム終了
180       If Not Selection.Find.Found Then
190           MsgBox "スペースで区切られた複数の単語を選択してください。"
200           End
210       End If
         
          '単語をひとつ選んだ場合にはプログラム終了
220       If Selection.Start <> SS Then
230           Selection.Start = SS
240           Selection.End = SE
250           MsgBox "スペースで区切られた複数の単語を選択してください。"
260           End
270       End If
         
280       If Selection.Find.Found Then Phrase = Selection

      '二つめ以降の単語の検索

290   Do
          '単語の検索(半角、全角スペース以外の文字列を検索します)
300       With Selection.Find
310           .Text = "([!  ]{1,})"
320           .Replacement.Text = ""
330           .Forward = True
340           .Wrap = wdFindStop
350           .Format = True
360           .MatchCase = False
370           .MatchWholeWord = False
380           .MatchByte = False
390           .MatchAllWordForms = False
400           .MatchSoundsLike = False
410           .MatchFuzzy = False
420           .MatchWildcards = True
430       End With
         
440       Selection.Find.Execute
         
450       If Not Selection.Find.Found Then Exit Do
         
460       If Selection.Find.Found Then
         
470           If Selection.End > SE Then
480               Selection.End = SE '末尾をそろえるための確認(日本語のとき役に立ちます)
490           End If
             
500           If Selection.Start = Selection.End Then
510               Selection.Start = SS
520               Selection.End = SE
530               MsgBox "スペースで区切られた複数の単語を選択してください。"
540               End
             
550           Else
560               word = Selection
570               Selection.Collapse direction:=wdCollapseEnd
580               Phrase = Phrase & "+*+" & word
590               Selection.Start = Selection.End
600               Selection.End = SE
             
610           End If
             
620       End If
         
630       If Selection.Start = SE Then Exit Do

640   Loop

650       URL = "http://www.google.co.jp/search?q=%22" & Phrase & "%22&lr="
660       ActiveDocument.FollowHyperlink address:=URL, NewWindow:=False, AddHistory:=True

          '検索窓をデフォルトの設定に変更
670       With Selection.Find
680           .Text = ""
690           .Replacement.Text = ""
700           .Forward = True
710           .Wrap = wdFindStop
720           .Format = True
730           .MatchCase = False
740           .MatchWholeWord = False
750           .MatchByte = False
760           .MatchAllWordForms = False
770           .MatchSoundsLike = False
780           .MatchWildcards = False
790           .MatchFuzzy = True
800       End With

End Sub

|

« ユーザーフォームのテキストボックス内で改行文字列を取り出す(その3) | トップページ | マクロインストーラーの更新 »

マクロプログラム」カテゴリの記事

コメント

コメントを書く



(ウェブ上には掲載しません)




トラックバック

この記事のトラックバックURL:
http://app.cocolog-nifty.com/t/trackback/519619/46629643

この記事へのトラックバック一覧です: Replace関数の例:右クリックでグーグルに活用してみた。:

« ユーザーフォームのテキストボックス内で改行文字列を取り出す(その3) | トップページ | マクロインストーラーの更新 »