1402140747 エクセルマクロを作ってください!文書出力関係


文書というシートに画像のようにA列にキーワード、B列にそのキーワードで呼び出す単語(文書)がならんでいます。

文書以外のシートでどのセルを選択していても、


マクロを開始すると、インプットボックスが出てきて、
「文書シートのA列のキーワードを入れてください。」


と表示され、A列の文字を入れてエンターを押すと、次のキーワードも連続で入れられるようにします。最後大文字や小文字の*(コメ)や*を入れると終了の合図で、
それまでに入れたキーワードに付随するB列のワードが連続でそのセルに入るようにしてほしいのです。(いいえか、キャンセルボタンもお願いします⇒すべて無効とします)

例・画像でいえば、13*と入力すれば、そのセルに「りんごレモン」
3穀物2*ならば、「レモン米みかん」と表示されます。


もともと、セルに何らかの情報が入っている場合はその情報のあとにいま入力されるべき文字列がつくことにします。またその何らかの情報の中に【■】があったら、いま入力される情報が置換されるとします。(ここはわかりづらいので追記します)

どうかよろしくお願いいたします。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2014/06/07 20:32:27
  • 終了:2014/06/11 11:44:46
id:naranara19

選択しているセルに、もともと

青森県特産
とあったとして、13*ならば、青森県特産りんごレモン
となります。


元々のセルに
僕の好きなものは【■】です。
とあって、3穀物2*ならば、
僕の好きなものはレモン米みかんです。

となります。【■】が2個以上あったとしたら、初めのもののみ置換されるものとします。

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912014/06/11 01:04:34

ポイント300pt

こんなことでしょうか?

Option Explicit

Sub あるプログラマのコード()
    Dim mRes
    Dim fRes As Range
    Dim cTxt As String
    Do While True
        mRes = InputBox("文書シートのA列のキーワードを入れてください。" & vbNewLine & cTxt, "naranara19 inputbox")
        If StrPtr(mRes) = 0 Then Exit Sub
        If StrConv(mRes, vbNarrow) = "*" Then Exit Do
        If mRes <> "" Then
            Set fRes = Worksheets("文書シート").Range("A:A").Find(mRes, lookat:=xlWhole)
            If Not fRes Is Nothing Then cTxt = cTxt & fRes.Offset(, 1).Value
        End If
    Loop
    If InStr(ActiveCell.Value, "【■】") > 0 Then
        ActiveCell.Value = Left(ActiveCell.Value, InStr(ActiveCell.Value, "【■】") - 1) & cTxt & Mid(ActiveCell.Value, InStr(ActiveCell.Value, "【■】") + 3)
    Else
        ActiveCell.Value = ActiveCell.Value & cTxt
    End If
End Sub
id:naranara19

いつもお世話になっております。長期にわたってご活躍されていらっしゃるんですね。完璧な内容でして、感謝、感謝です。

今後も投稿した際には、ぜひ見ていた打だけたら幸いです。どうかよろしくお願いいたします。

2014/06/11 11:44:28

その他の回答(0件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912014/06/11 01:04:34ここでベストアンサー

ポイント300pt

こんなことでしょうか?

Option Explicit

Sub あるプログラマのコード()
    Dim mRes
    Dim fRes As Range
    Dim cTxt As String
    Do While True
        mRes = InputBox("文書シートのA列のキーワードを入れてください。" & vbNewLine & cTxt, "naranara19 inputbox")
        If StrPtr(mRes) = 0 Then Exit Sub
        If StrConv(mRes, vbNarrow) = "*" Then Exit Do
        If mRes <> "" Then
            Set fRes = Worksheets("文書シート").Range("A:A").Find(mRes, lookat:=xlWhole)
            If Not fRes Is Nothing Then cTxt = cTxt & fRes.Offset(, 1).Value
        End If
    Loop
    If InStr(ActiveCell.Value, "【■】") > 0 Then
        ActiveCell.Value = Left(ActiveCell.Value, InStr(ActiveCell.Value, "【■】") - 1) & cTxt & Mid(ActiveCell.Value, InStr(ActiveCell.Value, "【■】") + 3)
    Else
        ActiveCell.Value = ActiveCell.Value & cTxt
    End If
End Sub
id:naranara19

いつもお世話になっております。長期にわたってご活躍されていらっしゃるんですね。完璧な内容でして、感謝、感謝です。

今後も投稿した際には、ぜひ見ていた打だけたら幸いです。どうかよろしくお願いいたします。

2014/06/11 11:44:28
  • id:kota_46ra
    13歳以上のみで規制する意味は?
  • id:foobar_777
    foobar_777 2014/06/08 15:23:10
    説明に不足部分があります。
    例えば、A列に2桁以上の数字は絶対にないのか? もし2桁以上の数字がある場合どうなるか?
    などなど……

    http://el.jibun.atmarkit.co.jp/photos/uncategorized/2010/02/23/project_comedy_l.gif
    の図の「プログラマのコード」で良ければ現状の説明内容でも作れますが…
  • id:naranara19
    こんにちは。13歳以上に規制する意味はとくになく、デフォルトのままです。

    2ケタ以上の数字になることはあります。その場合も同じでお願いいたします。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません