タイトル説明文のサンプル提案ファイルを作りたいのです。

質問

仕事で必要なので、Excel VBAを教えてもらえないでしょうか。
VBAは初心者です。

タイトル説明文のサンプルを出すファイルが作りたいので、シート1の
A1に入れたキーワードのタイトルと説明文のサンプルをシート2のA1:B5
に出すような形にしたいのですが、どう書いたらいいでしょうか？

用意したいと思っているのはこのようなシートです。
シート1・・・A1にはキーワードを入れる。
シート2・・・A1:B5までサンプルを表示したい。
シート3・・・タイトルと説明文が列ごとに入っている。

シート2には、候補を5つくらいランダムで出したいと思ってます。

シート3のA列には、「○○ならこちら！」というようなタイトルが
入っており、B列には、「安くておいしい○○が今なら無料です。」と
いうような説明文を入れます。

それをシート1のA1のキーワードを入れたタイトル説明文にして、シート
2にサンプルを5つ出したいのです。

※シート1のA1が「みかん」なら「みかんならこちら！」「安くておい
しいミカンが今なら無料です。」となるという感じです。

シート1のA1のキーワードを○○で置換しただけのものをシート2に
出すのは、マクロの登録でできたのですが、文字数によって出すタイ
トルと説明文を変えたいので困っています。

A列とB列には2文字のキーワード用のタイトルと説明文しか入ってない、
C列とD列には3文字のタイトルと説明文しか入ってないというようにして
おいて、シート1のA1のキーワードの文字数が2文字だったらA列のタイ
トルとB列の説明文をシート2のA1:B5にランダムで出したいのです。

どうしたらいいでしょうか？

VBAのサイトを見てもわかりませんでした…。

この説明ではわかりにくいかもしれませんが、どう書いたらいいのか
教えて頂けるとありがたいです。

よろしくお願いします。

回答No.3

noname#144013 · ベストアンサー

こんにちは。　FarEyesです。

＞ ただ、これから4文字、5文字、6文字、7文字、8文字、9文字、10文字と
＞ 増えるのです。
＞ その場合どうしたらいいでしょうか？

でしたら、#1で述べたように、シート３には、A列とB列の２列のみで抽出用の
「タイトル」と「説明文」を登録しておいて、その中の置換対象の文字列（例え
ば"○○"）を、単純に入力したキーワードと置き換えてシート２に表示するよう
にすれば良いと思います。

また、文字数制限などがある場合は、シート２に「タイトルの文字数」及び、
「説明文の文字数」の欄を設けておいて、そこに文字数（マクロで作成した置換
後の文字列の文字数）を表示するようにしておけば、作成されたサンプル候補
の中から該当する文字数以内のサンプルのみ選ぶこともできると思います。

以下は、上記構成のワークシートの例です。

■シート構成の例
＜シート２＞
　　　　　　　　A　　　　　　　　　　　　　　　B　　　　　　　　　　　　　　　　　　　　　　　　　C　　　　　　　D　　
　　1　　タイトル　　　　　　　　　　 説明文　　　　　　　　　　　　　　　　　　　　　　　タイトルの　　説明文の
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　文字数　　　　文字数
　　2　　『りんご』も～～　　　　　 お夜食に『りんご』～～　　　　　　　　　　　　　　　　　　 8　　　　　　 11
　　3　　『りんご』の～～　　　　　ご朝食に『りんご』～～　　　　　　　　　　　　　　　　　　 8　　　　　　 11
　　4　　『りんご』ならこちら！　　安くておいしい『りんご』が今なら無料です。　　　　　 11　　　　　　 21
　　5　　『りんご』で～～　　　　　旬な『りんご』～～　　　　　　　　　　　　　　　　　　　　　 8　　　　　　 9
　　6　　『りんご』が～～　　　　　お弁当に『りんご』～～　　　　　　　　　　　　　　　　　　 8　　　　　　 11

　　※１行目は固定の項目名とします。（この行は予め手入力しておくものとします。）
　　※A列～D列の２行目以降は、マクロにより自動登録する部分です。

＜シート３＞
　　　　　　　　A　　　　　　　　　　　　　　　B　　
　　1　　タイトル　　　　　　　　　　 説明文　　　
　　2　　『○○』ならこちら！　　　安くておいしい『○○』が今なら無料です。
　　3　　『○○』を～～　　　　　　 こちらの『○○』～～
　　4　　『○○』は～～　　　　　　おいしく『○○』～～
　　5　　『○○』に～～　　　　　　おいしい『○○』～～
　　6　　『○○』で～～　　　　　　旬な『○○』～～
　　7　　『○○』と～～　　　　　　 新鮮な『○○』～～
　　8　　『○○』の～～　　　　　　ご朝食に『○○』～～
　　9　　『○○』へ～～　　　　　　ご夕食に『○○』～～
　 10　　『○○』が～～　　　　　　お弁当に『○○』～～
　 11　　『○○』も～～　　　　　　 お夜食に『○○』～～

　　※こちらは、予めユーザーが登録しておくシートです。
　　※"○○"の部分が入力したキーワードに置き換わる部分とします。

以下に、上記の仕様に合わせて、#1のサンプルマクロを改造したバージョンの
マクロを記載しています。

＜サンプルマクロの補足＞
１）シート１のコードモジュールは、特に変更する必要がないので、今回は標準
　モジュールのマクロのみ記載しています。

２）このマクロを使用する際は、現在ご使用のワークブックはそのままにしてお
　いて新規にワークブックを作成し、そのワークブックのコードモジュールに貼り
　付けて、ご利用下さい。
　その際は、#1のシート１のコードモジュールもコピー＆ペーストして下さい。
　また、各ワークシートも、既存のシートからコピー＆ペーストしたのち、仕様に
　合わせて編集して下さい。

３）グローバルな定数として、下記の定数を追加しています。
　　'==グローバル定数==
　　Public Const KEYWORD_LMIN As Integer = 1　 'キーワードの最小文字数
　　Public Const KEYWORD_LMAX As Integer = 10　'キーワードの最大文字数
　※これは、シート１のA1セルに入力するキーワードの文字数制限のために
　　設けています。
　※サンプル上は仮の値ですので、この設定値は、ご利用の都合に合わせて
　　変更して下さい。
　※マクロ実行時に、シート１で入力されたキーワードの文字数をチェックして、
　　それがこの設定文字数の範囲外だった場合は、メッセージを表示するよう
　　にしています。

４）シート３に登録する「タイトル」と「説明文」の各文字列において、キーワードと
　置換する部分には、"○○"（"○"×２文字）の文字列を設定して下さい。
　※マクロの処理で、この文字列【コード上は、String(2, "○")の部分】とキー
　　ワードを置換するようにしています。

５）シート２に追加した「タイトルの文字数」と「説明文の文字数」を表示するため
　の処理を追加しています。

■サンプルマクロ（#1の改造版）
注）インデント等のため、全角スペースを入れています。

＜標準モジュール＞
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option Explicit
'==グローバル定数==
Public Const KEYWORD_LMIN As Integer = 1　 'キーワードの最小文字数
Public Const KEYWORD_LMAX As Integer = 10　'キーワードの最大文字数
'
'== サンプルタイトル作成 ==
'※引数 strItem は、「タイトル＆説明文」で置き換えるキーワード文字列
Sub MakeSampTitle(ByVal strItem As String)

　　Dim i As Long　　　　　 'ループ用変数
　　Dim imax1 As Long　　　 'ループ用変数(ループ数)
　　Dim imax2 As Long　　　 'ループ用変数(ループ数)
　　Dim nPos As Long　　　　'配列の要素位置
　　Dim nLenItem As Long　　'引数文字列(キーワード)の文字数
　　Dim nTemp As Long　　　 '汎用の数値ワーク
　　Dim nAryNo() As Long　　'整数配列
　　Dim nArySize As Long　　'整数配列の要素数
　　Dim strTitle As String　'タイトルの文字列
　　Dim strComment As String '説明文の文字列
　　Dim strMsg As String　　'メッセージ用文字列

　　'乱数初期化
　　Randomize

　　'==引数の文字列（キーワード）の文字数を取得==
　　nLenItem = Len(strItem)
　　If nLenItem < KEYWORD_LMIN Or _
　　　 nLenItem > KEYWORD_LMAX Then
　　　　'文字数が規定範囲外ならメッセージを表示して戻る
　　　　strMsg = "キーワードの文字数が規定範囲外です。" + vbLf
　　　　strMsg = strMsg & "※規定文字数は " & KEYWORD_LMIN
　　　　strMsg = strMsg & "～" & KEYWORD_LMAX & " 文字です。"
　　　　MsgBox strMsg, vbExclamation Or vbOKOnly
　　　　Exit Sub
　　End If

　　'==整数配列の要素数を確定する==
　　'※シート3のA列の登録データ数を要素数とする
　　'※１行目が項目名のため、データ最終行の行位置から－１する
　　nArySize = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row - 1

　　'シート3に登録文字列がないとき（要素数が１未満）は戻る
　　If nArySize < 1 Then
　　　　Exit Sub
　　End If

　　'確定した要素数で整数配列を再確保
　　ReDim nAryNo(0 To nArySize - 1)

　　'整数配列に1～nArySizeまでの数値を順番にセット
　　For i = 1 To nArySize
　　　　nAryNo(i - 1) = i
　　Next i

　　'==整数配列の要素をランダムに入れ換える==
　　'※入れ換え回数はnArySizeの値分
　　For i = 1 To nArySize
　　　 nPos = Int(Rnd * nArySize)
　　　 nTemp = nAryNo(nPos)
　　　 nAryNo(nPos) = nAryNo(i - 1)
　　　 nAryNo(i - 1) = nTemp
　　Next i

　　'==シート2にシート3より抽出した「タイトル＆説明文」をセット==
　　imax1 = 5　　　 'シート2への最大のデータ登録数（セル範囲の行数）
　　imax2 = imax1　 'シート2への有効なデータ登録数（初期値は最大数と同じ）
　　If nArySize < imax1 Then
　　　　'シート3のデータ登録数が５個未満ならシート2への有効登録数もその数
　　　　'とする
　　　　imax2 = nArySize
　　End If
　　For i = 1 To imax1　'最大のデータ登録数分ループ
　　　　If i <= imax2 Then
　　　　　　'データ登録位置が有効登録数以内のとき
　　　　　　'※A列の「タイトル」とB列の「説明文」を取得
　　　　　　'※取得する位置は整数配列の値から参照
　　　　　　strTitle = Sheets(3).Range("A" & nAryNo(i - 1) + 1).Value
　　　　　　strComment = Sheets(3).Range("B" & nAryNo(i - 1) + 1).Value
　　　　　　'「タイトル＆説明文」の文字列中の"○"の部分を引数の文字列に置き換える
　　　　　　'※当マクロでは置換対象文字列は"○○"とする【String(2, "○")の部分】
　　　　　　strTitle = Replace(strTitle, String(2, "○"), strItem)
　　　　　　strComment = Replace(strComment, String(2, "○"), strItem)
　　　　Else
　　　　　　'データ登録位置が有効登録数を超えたとき
　　　　　　'「タイトル＆説明文」を空き文字列とする
　　　　　　strTitle = ""
　　　　　　strComment = ""
　　　　End If
　　　　'==シート2の該当位置へ置き換え後の「タイトル＆説明文」と、
　　　　'==それぞれの文字数を格納する
　　　　'==※１行目が項目名のため行位置は＋１する
　　　　Sheets(2).Range("A" & i + 1).Value = strTitle　　'タイトルを格納
　　　　Sheets(2).Range("B" & i + 1).Value = strComment　'説明文を格納
　　　　'タイトルの文字数を格納
　　　　If strTitle <> "" Then
　　　　　　Sheets(2).Range("C" & i + 1).Value = Len(strTitle)
　　　　Else
　　　　　　Sheets(2).Range("C" & i + 1).Value = ""
　　　　End If
　　　　'説明文の文字数を格納
　　　　If strComment <> "" Then
　　　　　　Sheets(2).Range("D" & i + 1).Value = Len(strComment)
　　　　Else
　　　　　　Sheets(2).Range("D" & i + 1).Value = ""
　　　　End If
　　Next i

End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

添付画像は、上記仕様のExcelシート画面をキャプチャしたものです。

以上です。参考になれば幸いです。

お礼

FarEyesさん

今更ですが、ありがとうございました！！

ようやく2003で試す機会ができました！
バリバリ使ってます。

ありがとうございました！！

回答No.2

noname#144013

こんにちは。　#1です。

当方は、Excel2007を持っていない＆使用できる環境もないため、質問者さんと
同じ環境で検証できないため、申し訳ありません。

以下は、推測でのコメントになります。

＞ Excel2007を使用しているせいか、実行するマクロ名を選択するポップアップ
＞ が出てもこのマクロ名が出ず…。

今回のマクロ（標準モジュール側のマクロ）では、「引数」のある関数を使用して
いるため、メニュー操作で、
　　「ツール」→「マクロ」→「マクロ」
　　　注）Excel2007では操作が違うかもしれません。
と選択して表示される「マクロ一覧」のポップアップ画面には、マクロ名は、
『表示されない』と思われます。
※これは、正常動作だと思います。マクロ名が表示されなくても問題ありません。
　（Excelがそういう仕様になっているようです。たぶん。。。）

以下の操作を行ってみて下さい。

１）シート１のA1セルに、適当に「みかん」とか「りんご」とかの文字列（２文字、
　もしくは、３文字）を入れて、[Enter]キーを押してみて下さい。
２）このアクションで、シート１のコードモジュール内の、
　　　Private Sub Worksheet_Change(ByVal Target As Range)
　が実行されるはずです。
３）上記２）が実行されれば、標準モジュール内の、
　　　Sub MakeSampTitle(ByVal strItem As String)
　も実行されるはずです。
４）シート２に、該当のサンプル（タイトル＆説明文）が表示されていれば、
　正常動作です。

また、念のため、下記の確認操作も行ってみて下さい。

１）Excelのセキュリティ関連の設定で、マクロが有効な設定になっているか？
　※もし、有効でなかった場合は、有効に設定して下さい。
２）Visual Basic Editor（VBE）を起動して、標準モジュールなどのコード画面を表示
　させて（ここで念のため、マウスカーソルをコード画面上に持っていって一度左クリ
　ックして下さい）、
　　　メニュー操作：　「デバッグ」→「VBA Projectのコンパイル」
　　　注）Excel2007では、操作が違うかもしれません。
　の操作を行ってみて下さい。
　※これで、コードがコンパイルされます。
３）これで何も表示されなければ、コード上の構文エラーなどは、なかったという
　ことになります。
　※もしも、コンパイルエラーがあった場合は、エラー箇所が表示されます。
　　その場合は、エラー箇所が、Excel2007のマクロの構文にあっていない可能性が
　　ありますので、ヘルプor文献、及び、WEBの情報などを参照して、対応する構文に、
　　ご自身で修正してみて下さい。

以上です。
あまりお役に立てなくてすみません。（上手くいくとイイですね！）

お礼

FarEyesさん

普通にA1に入れてエンターでできました！
ありがとうございました！！

こんな親切な方がいるなんて、感謝感激です…。

オウケイウェイブに聞いて良かったです…。

ただ、これから4文字、5文字、6文字、7文字、8文字、9文字、10文字と
増えるのです。

その場合どうしたらいいでしょうか？

ホントに何度もすみません！

よろしくお願いします！

回答No.1

noname#144013

こんにちは。

サンプルマクロを作成してみました。
※あくまで一例です。
※当方は、Excel2000で試してみました。

■マクロの処理概要
１）シート１のA1セルの値（文字列）が変更されたら、「タイトル＆説明文」作成用の関数
　「MakeSampTitle()」を実行する。
　※その際に、関数への引数としてA1セルの文字列を渡す。
２）関数「MakeSampTitle()」では、シート３上に登録された複数の「タイトル＆説明文」の
　中よりランダムに選んだ（最大５組）、「タイトル＆説明文」の文字列中の"○"の部分を、
　引数で渡された文字列に置き換えて、それをシート２の該当セルへ格納する。

■補足
　ひとつの案ですが、

　シート３に登録する「タイトル＆説明文」の文字列の組ですが、今回のサンプルマクロ
　では、ご提示の仕様に合わせて、２文字用の組（A列、B列）と、３文字用の組（C列、D列）
　とに分けて作成してありますが、

　これを分けずに、以下のように、１組のみ（A列、B列のみで、C列、D列は使用しない）
　の構成にするやり方も可能かと思います。

　＜例＞
　　◎シート３
　　　　　　A列　　　　　　　　　　　　B列
　　　『○○』ならこちら！　　　 安くておいしい『○○』が今なら無料です。
　　　　　　　：　　　　　　　　　　　　　：
　　　　　　　：　　　　　　　　　　　　　：

　　としておいて、

　　◎シート１
　　　A1 ＝ みかん

　　だった場合に、

　　◎シート２
　　　　　　A列　　　　　　　　　　　　B列
　　　『みかん』ならこちら！　　 安くておいしい『みかん』が今なら無料です。
　　　　　　　：　　　　　　　　　　　　　：
　　　　　　　：　　　　　　　　　　　　　：

　　となるような作りにもできるかと思います。

　　※シート３の登録文字列を取得して、文字列中の"○○"の部分を、シート１の
　　　A1の文字列に単純に置き換えたものを、シート２の該当セルに格納するよう
　　　にすれば、シート１のA1の「文字数」に関係なく処理できるかと思います。
　　※今回のサンプルマクロも、少し変更すれば、上記のような構成にも対応
　　　できるような作りにしてあるつもりです。

■サンプルマクロ
注）インデントなどのため、全角スペースを入れています。

＜補足＞
　シートへのアクセスは、
　　　シート１　＝　１番目のシート　⇒　Sheets(1)
　　　シート２　＝　２番目のシート　⇒　Sheets(2)
　　　シート３　＝　３番目のシート　⇒　Sheets(3)
　としています。

◎シート１のコードモジュール
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option Explicit
'== シート1のセル内容変更時のイベント処理 ==
Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim strMsg As String　'メッセージ用文字列

　　'変更されたセルが"A1"以外なら戻る
　　If Target.Address <> "$A$1" Then Exit Sub

　　'該当セルの文字列が空きならメッセージを表示して戻る
　　If Target.Text = "" Then
　　　　strMsg = "A1セルには文字列を入れて下さい。"
　　　　MsgBox strMsg, vbExclamation Or vbOKOnly
　　　　Exit Sub
　　End If

　　'A1セルの文字列からサンプルタイトル作成
　　Call MakeSampTitle(Target.Text)

End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

◎標準モジュール
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option Explicit
'== サンプルタイトル作成 ==
'※引数 strItem は、「タイトル＆説明文」で置き換える文字列
Sub MakeSampTitle(ByVal strItem As String)

　　Dim i As Long　　　　　 'ループ用変数
　　Dim imax1 As Long　　　 'ループ用変数(ループ数)
　　Dim imax2 As Long　　　 'ループ用変数(ループ数)
　　Dim nPos As Long　　　　'配列の要素位置
　　Dim nLenItem As Long　　'引数文字列の文字数
　　Dim nTemp As Long　　　 '汎用の数値ワーク
　　Dim nAryNo() As Long　　'整数配列
　　Dim nArySize As Long　　'整数配列の要素数
　　Dim strTitle As String　'タイトルの文字列
　　Dim strComment As String '説明文の文字列
　　Dim strMsg As String　　'メッセージ用文字列

　　'乱数初期化
　　Randomize

　　'==引数の文字列の文字数を取得==
　　nLenItem = Len(strItem)
　　If nLenItem < 1 Then
　　　　'引数の文字列が空き（文字数が１未満）なら戻る
　　　　Exit Sub
　　End If

　　'==整数配列の要素数を確定する==
　　nArySize = 0　　'要素数を０で初期化
　　If nLenItem = 2 Then
　　　　'引数文字列の文字数が２文字のとき
　　　　'※シート3のA列の登録データ数を要素数とする
　　　　'※１行目が項目名のため、データ最終行の行位置から－１する
　　　　nArySize = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row - 1
　　ElseIf nLenItem = 3 Then
　　　　'引数文字列の文字数が３文字のとき
　　　　'※シート3のC列の登録データ数を要素数とする
　　　　'※１行目が項目名のため、データ最終行の行位置から－１する
　　　　nArySize = Sheets(3).Range("C" & Rows.Count).End(xlUp).Row - 1
　　Else
　　　　'引数文字列の文字数が２文字でも３文字でもないときは戻る
　　　　Exit Sub
　　End If

　　'シート3に登録文字列がないとき（要素数が１未満）は戻る
　　If nArySize < 1 Then
　　　　Exit Sub
　　End If

　　'確定した要素数で整数配列を再確保
　　ReDim nAryNo(0 To nArySize - 1)

　　'整数配列に1～nArySizeまでの数値を順番にセット
　　For i = 1 To nArySize
　　　　nAryNo(i - 1) = i
　　Next i

　　'==整数配列の要素をランダムに入れ換える==
　　'※入れ換え回数はnArySizeの値分
　　For i = 1 To nArySize
　　　 nPos = Int(Rnd * nArySize)
　　　 nTemp = nAryNo(nPos)
　　　 nAryNo(nPos) = nAryNo(i - 1)
　　　 nAryNo(i - 1) = nTemp
　　Next i

　　'==シート2にシート3より抽出した「タイトル＆説明文」をセット==
　　imax1 = 5　　　 'シート2への最大のデータ登録数（セル範囲の行数）
　　imax2 = imax1　 'シート2への有効なデータ登録数（初期値は最大数と同じ）
　　If nArySize < imax1 Then
　　　　'シート3のデータ登録数が５個未満ならシート2への有効登録数もその数
　　　　'とする
　　　　imax2 = nArySize
　　End If
　　For i = 1 To imax1　'最大のデータ登録数分ループ
　　　　If i <= imax2 Then
　　　　　　'データ登録位置が有効登録数以内のとき
　　　　　　If nLenItem = 2 Then
　　　　　　　　'引数文字列の文字数が２文字のとき
　　　　　　　　'※A列の「タイトル」とB列の「説明文」を取得
　　　　　　　　'※取得する位置は整数配列の値から参照
　　　　　　　　strTitle = Sheets(3).Range("A" & nAryNo(i - 1) + 1).Value
　　　　　　　　strComment = Sheets(3).Range("B" & nAryNo(i - 1) + 1).Value
　　　　　　Else
　　　　　　　　'引数文字列の文字数が３文字のとき
　　　　　　　　'※C列の「タイトル」とD列の「説明文」を取得
　　　　　　　　'※取得する位置は整数配列の値から参照
　　　　　　　　strTitle = Sheets(3).Range("C" & nAryNo(i - 1) + 1).Value
　　　　　　　　strComment = Sheets(3).Range("D" & nAryNo(i - 1) + 1).Value
　　　　　　End If
　　　　　　'「タイトル＆説明文」の文字列中の"○"の部分を引数の文字列に置き換える
　　　　　　strTitle = Replace(strTitle, String(nLenItem, "○"), strItem)
　　　　　　strComment = Replace(strComment, String(nLenItem, "○"), strItem)
　　　　Else
　　　　　　'データ登録位置が有効登録数を超えたとき
　　　　　　'「タイトル＆説明文」を空き文字列とする
　　　　　　strTitle = ""
　　　　　　strComment = ""
　　　　End If
　　　　'シート2の該当位置へ置き換え後の「タイトル＆説明文」をセット
　　　　Sheets(2).Range("A" & i).Value = strTitle
　　　　Sheets(2).Range("B" & i).Value = strComment
　　Next i

End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

参考までに、上記サンプル実行後のExcelシート画面のキャプチャ画像を添付
しています。
※ご使用のブラウザ上のFlash機能が対応していれば、画像の拡大が可能か
　と思います。（画像上で右クリックでメニューがでると思います。）

以上です。
ご要望のものとは違っていた場合はすみません。
参考になれば幸いです。

お礼

FarEyesさん

ありがとうございます！
上のコードをシート1に、下のコードを標準モジュールに貼り付けてみま
した！

Excel2007を使用しているせいか、実行するマクロ名を選択するポップアップ
が出てもこのマクロ名が出ず…。
悪戦苦闘しています。

どうやったら出せるのか調べてみます。

シート3のデータはA列とB列だけにしてしまってもよいのですが、出したい
タイトルと説明文は文字数制限があるので、2文字はA列とB列、3文字は
C列とD列に分けました…。

でも、統合できるならそっちの方がいいですね。