-1

MS Word 文書で特殊な文字列が出現する総数を数えようとしています。検索文字列は次のとおり(\{F)(*)(\})です。

function CountOcc(SString:string): Integer;
var
   aFindText, aMatchCase,aWrap,AMatchWholeWord,aReplaceWith,aReplace: OleVariant;
   Result1: boolean
begin
   Result := False;
   aFindText := SString;
   aMatchCase := false;
   aMatchWholeWord := true;
   aWrap := wdFindContinue;
   aReplace:=wdReplaceNone;
   aMatchWildCards:=true;
   aReplaceWith:=SString;
   try
     Result1:=WordContainer.OleObject.ActiveWindow.Selection.Range.Find.Execute(
                aFindText
              , aMatchCase
              , aMatchWholeWord
              , aMatchWildCards
              , EmptyParam, EmptyParam, EmptyParam, aWrap, EmptyParam
              , aReplaceWith, aReplace
              , EmptyParam, EmptyParam,EmptyParam, EmptyParam);
   finally
     if Result1 then ........
   end;
end;

検索文字列の出現回数を取得するにはどうすればよいですか?

4

2 に答える 2

2

次の 2 つのオプションがあります。

オプション 1 1
つは、出現箇所が見つからなくなるまでコードとループを使用することです。このサイトの vba コードを参照してください: http://wordribbon.tips.net/T010761_Generating_a_Count_of_Word_Occurrences.html

Delphi で以下のコードを翻訳する必要があります。

Sub FindWords()
    Dim sResponse As String
    Dim iCount As Integer

    ' Input different words until the user clicks cancel
    Do
        ' Identify the word to count
        sResponse = InputBox( _
          Prompt:="What word do you want to count?", _
          Title:="Count Words", Default:="")

        If sResponse > "" Then
            ' Set the counter to zero for each loop
            iCount = 0
            Application.ScreenUpdating = False
            With Selection
                .HomeKey Unit:=wdStory
                With .Find
                    .ClearFormatting
                    .Text = sResponse
                    ' Loop until Word can no longer
                    ' find the search string and
                    ' count each instance
                    Do While .Execute
                        iCount = iCount + 1
                        Selection.MoveRight
                    Loop
                End With
                ' show the number of occurences
                MsgBox sResponse & " appears " & iCount & " times"
            End With
            Application.ScreenUpdating = True
        End If
    Loop While sResponse <> ""
End Sub

オプション 2
もう 1 つのオプションは、テキスト全体を Delphi 文字列にコピーして貼り付け、それを検索することです。
発生回数が多い場合、これはより速く実行される可能性があります。参照: Delphi: 文字列が別の文字列に出現する回数を数える

....
uses Clipbrd;
....

function Occurrences(const Substring, Text: string): integer; //thx Andries
var
  offset: integer;
begin
  result := 0;
  offset := PosEx(Substring, Text, 1);
  while offset <> 0 do
  begin
    inc(result);
    offset := PosEx(Substring, Text, offset + length(Substring));
  end;
end;

function GetCount(what: string): integer;
var
  CopyOfText: string;
  i: integer;
begin
  WordContainer.OleObject.ActiveWindow.SelectAll;
  WordContainer.OleObject.ActiveWindow.Copy;
  CopyOfText:= Clipboard.AsText;
  Result:= Occurrences(what, CopyOfText);
end;
于 2013-09-23T18:46:58.567 に答える
0

単語の出現箇所を検索し、それらを配列で返す関数。Word VBA ワイルドカード検索の一致 Il mio コードを参照してください。

function TForm1.Esiste(SString:string): TArr;
var
   aFindText, aMatchWildCards, aMatchCase,aWrap,aMatchAllWordForms,
   AMatchWholeWord,aReplaceWith,aReplace,aForward: OleVariant;
   Count:integer;
   ris : TArr;
begin
   Count:=0;
   aFindText := SString;
   aForward:=True;
   aWrap := wdFindContinue;
   aMatchWildCards:=true;
   aMatchCase := false;
   aMatchWholeWord := true;
   aMatchAllWordForms:=false;
   aReplaceWith := '';
   aReplace:=wdReplaceNone;
   while WordApp.Selection.Range.Find.Execute(
                aFindText
              , aMatchCase
              , aMatchWholeWord
              , aMatchWildCards
              , EmptyParam, aMatchAllWordForms, aForward, aWrap, EmptyParam
              , aReplaceWith, aReplace
              , EmptyParam, EmptyParam,EmptyParam, EmptyParam) do begin
               Count:=count+1;
               SetLength(ris,Count);
               Ris[Count-1]:=WordApp.Selection.Text;
   end;
   Result:=Ris;
end;

while は無限ループを生成します。もしも

..
aReplaceWith: = 'any text';
aReplace: = wdReplaceOne;
..

常にドキュメントの最初の文字を返します

(Ris [Count-1]: = WordApp.Selection.Text;)

ヘルプ

于 2013-09-29T14:48:51.483 に答える