文章リライト/生成ツール（プログラム）探しています

質問

お世話になっております。
タイトルのとおりなのですが、ある文章を同義語で置換して作成してくれるツールを探しています。
もしツールがない場合、プログラムでも構いません。
サンプルのソースをご存知ない場合は、どのように作るべきか、方針などをご教授頂けますと幸いです。
お手数をお掛けしますが、何卒よろしくお願いいたします！

（例）
【文章】
　　iPhone7の価格はいくらですか？
【同義語】
　　・iPhone→アイフォン,アイフォーン
　　・価格→値段,金額
【アウトプット】
　　iPhone7の価格はいくらですか？（原文）
　　iPhone7の値段はいくらですか？
　　iPhone7の金額はいくらですか？
　　アイフォン7の価格はいくらですか？
　　アイフォン7の値段はいくらですか？
　　アイフォン7の金額はいくらですか？
　　アイフォーン7の価格はいくらですか？
　　アイフォーン7の値段はいくらですか？
　　アイフォーン7の金額はいくらですか？

回答No.1

neKo_quatre

置換が出来て文字列扱える言語なら、逐次置換していくとか。
Excelで作れると良かったですが、なんか上手くいかなかったのでWord VBAで、

・Wordを起動。
・Alt+F11でVBのエディタ起動。
・左側のプロジェクトエクスプローラで、開いている多分「Project(文書1)」を右クリック-[挿入]-[標準モジュール]
・Module1が挿入されたら、ちょっと長いですが、以下をコピペ。

－－－－－ここから－－－－－
Option Explicit
Sub RapidReplace()
Dim strSrc As String
Dim strReplace As String
Dim vCntCounter() As Integer
Dim vCntBound() As Integer
Dim iCntCol As Integer
Dim iIndex As Integer

strSrc = "iPhone7の価格はいくらですか？"
strReplace = "iPhone,アイフォン,アイフォーン 価格,値段,金額"

' カウンタ初期化
iCntCol = CountItem1(strReplace)
ReDim vCntCounter(iCntCol - 1)
ReDim vCntBound(iCntCol - 1)
For iIndex = 0 To iCntCol - 1
vCntCounter(iIndex) = 0
vCntBound(iIndex) = CountItem2(strReplace, iIndex)
Next iIndex

' ループ
Do
Selection.TypeText Text:=CntReplace(strSrc, strReplace, vCntCounter, iCntCol)
Selection.TypeParagraph
Loop While CntInclement(vCntCounter, vCntBound, iCntCol)

Selection.TypeParagraph
End Sub
Function CntReplace(strSrc As String, strReplace As String, vCntCounter() As Integer, iCntCol As Integer)
Dim iIndex As Integer
Dim vReplace() As String
Dim vReplace2() As String

CntReplace = strSrc
vReplace = Split(strReplace)
For iIndex = 0 To iCntCol - 1
Erase vReplace2
vReplace2 = Split(vReplace(iIndex), ",")
CntReplace = Replace(CntReplace, vReplace2(0), vReplace2(vCntCounter(iIndex)))
Next iIndex
End Function
Function CntInclement(ByRef vCntCounter() As Integer, vCntBound() As Integer, iCntCol As Integer) As Boolean
Dim iIndex

For iIndex = iCntCol - 1 To 0 Step -1
If vCntCounter(iIndex) + 1 < vCntBound(iIndex) Then ' インクリメント可能
vCntCounter(iIndex) = vCntCounter(iIndex) + 1
CntInclement = True
Exit Function
Else ' 繰り上がり
vCntCounter(iIndex) = 0
End If
Next iIndex
CntInclement = False
End Function
Function CountItem1(strReplace) As Integer
Dim vReplace() As String
vReplace = Split(strReplace)
CountItem1 = UBound(vReplace) - LBound(vReplace) + 1
End Function

Function CountItem2(strReplace, iIndex) As Integer
Dim vReplace() As String
Dim vReplace2() As String
vReplace = Split(strReplace)
vReplace2 = Split(vReplace(iIndex), ",")
CountItem2 = UBound(vReplace2) - LBound(vReplace2) + 1
End Function
－－－－－ここまで－－－－－

・Wordに戻り、Alt+F8を押してマクロ画面を呼び出し、「RapidReplace」を実行。

文章変更する場合、プログラムの前のほうのキーワードをいじります。
質問文で言う同義語は、空白区切りとカンマ区切りの文字列で指定して下さい。

お礼

neKo_quatreさん
ありがとうございます！
エラーがでてしまいご連絡遅くなり申し訳御座いません。
文書が約1,000、同義語が70,000近くあるので、エクセルなどで出来ると非常にありがたいです(>_<)
いただいたコードを参考にさせていただき、私も作ってみます！
本当にありがとうございました！！