-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

There are two options:

Option 1
One is to use your code and loop until you can no longer find occurrences. See the vba code from the this site: http://wordribbon.tips.net/T010761_Generating_a_Count_of_Word_Occurrences.html

You'll have to translate the below code in 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

Option 2
The other option is to copy/paste the entire text to a Delphi string and search that.
If there are many occurrences, this may execute faster. See also: Delphi: count number of times a string occurs in another string

....
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 回答