| |
weipuzhenfu さん、こんばんは。
>まず、Ｗｏｒｄに文章
> Ｅｘｃｅｌに列Ａ：番号
> 列Ｂ：キーワード
> 列Ｃ：出現回数
>があります。
>Ｗｏｒｄの文章の単語が Ｅｘｃｅｌのキーワードに
>該当すれば、Ｗｏｒｄ文章中のその単語に識別のために
>何らかの書式設定（例えば、アンダーライン）を施し、
>かつ、Ｅｘｃｅｌの列Ｃに頻出回数を累積してカウント
>する。
上記エクセルファイルの名前がLIST1.xls、リストのあるシートがSheet1、リストは１行目が見出しでこんなレイアウト。
A B C
1 キー カウント
2 1 Ｗｏｒｄ
3 2 Ｅｘｃｅｌ
4 3 文章
ワード文書は質問投稿文をそのまま貼り付けてテストしました。
マクロはワードVBEに全部記述します。
Sub Main()
Dim xlApp As Object, obj As Object, rr As Long, s1 As String
'Excelの処理
'ヘルプのCreateObjectからほぼそのまま転載
Set xlApp = CreateObject("excel.application")
'フォルダはdocファイルと同じところから開く。 ファイル名は LIST1.xls
Set obj = xlApp.Workbooks.Open(ThisDocument.Path & "\LIST1.xls")
rr = 1
Do
'B列
rr = rr + 1
s1 = obj.Worksheets("Sheet1").Cells(rr, 2).Value
If s1 = "" Then Exit Do 'カラになったら終わる
'結果はＣ列に入れる
obj.Worksheets("Sheet1").Cells(rr, 3).Value = S1NN(s1)
Loop
'エクセルは終了せずに置いておく(そのままマクロは終了)
xlApp.Visible = True
Set obj = Nothing
Set xlApp = Nothing ' オブジェクトの参照を解放します。
End Sub
'////////////////////Wordの処理
Function S1NN(s1 As String) As Long
'出現数をカウントするマクロ
Dim tf As Boolean
Dim NN As Long
'文書の先頭に移動
ActiveDocument.Range(Start:=0, End:=0).Select
'検索条件設定→開始
With Selection.Find
.ClearFormatting
.Text = s1
.Replacement.Text = ""
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = True
NN = 0 '検索を繰り返す
Do
tf = .Execute(Forward:=True)
If Not tf = True Then Exit Do
Selection.Range.HighlightColorIndex = wdYellow 'マーカーは黄色
NN = NN + 1
Loop
End With
'出現回数
S1NN = NN
End Function
エクセルファイルが開いたままだと上書きできなくなります（読み取り専用）。
|
|
りる
- 10/1/3(日) 21:04 -
![[未読]](./data/word/image/read_icon.gif){kind=icon}
