マクロでセル内の文章を一括HTMLタグ付けをしたい

質問

過去に同じような質問を差し上げているのですが、今回は若干の仕様変更のため説明も似たものになってます。
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1010731423...

前回ご回答いただいたVBAを改修していただいたら分かりやすいでしょうか。。？

------------------------↓セル内
ダミーテキストテキストテキストテキストテキストテキストテキストテキストテキストテキストテキストテキストテキストテキストテキスト

◆ダミータイトル
ダミーテキストテキストテキストテキストテキストテキスト

◆ダミータイトル
ダミーテキストテキストテキストテキストテキストダミーテキストテキストテキストテキストテキストダミーテキストテキストテキストテキストテキストダミーテキストテキストテキストテキストテキスト
ダミーテキストテキストテキストテキストテキストダミーテキストテキストテキストテキストテキスト
------------------------↑セル内

※テキストはダミーです。本来は日本語文章が入ります。
※上記例は小見出しの先頭に ◆ が書かれています。
※セル内の一番上には1行綴りの文章があります。
※タイトル（上記はダミータイトルと書かれた部分）の上には空白改行が1行あります。
※タイトル（上記はダミータイトルと書かれた部分）の下には1行綴りの文章があります。
※改行が2つ連続すれば、前後の段落を<p>タグで囲い、改行が1つの場合は<br />タグを挿入したいです。（下記参照）

今回も実行内容はクリップボードに保存したいです。

今回は上記の例を、以下のようにHTMLタグ付けしたいと思っております。
-----------------------------
<div class="cntt">
<p>ダミーテキストテキストテキストテキストテキストテキストテキストテキストテキストテキストテキストテキストテキストテキストテキスト</p>

<h3>◆ダミータイトル</h3>
<p>ダミーテキストテキストテキストテキストテキストテキスト</p>

<h3>◆ダミータイトル</h3>
<p>ダミーテキストテキストテキストテキストテキストダミーテキストテキストテキストテキストテキストダミーテキストテキストテキストテキストテキストダミーテキストテキストテキストテキストテキスト<br />
ダミーテキストテキストテキストテキストテキストダミーテキストテキストテキストテキストテキスト</p>
</div>
-----------------------------
Windows7 , Excel2007 , Dreamweaver CS5.5を使用しています。

不明点がございましたらご連絡ください。
よろしくお願いいたします。

回答No.1

noname#184106 · ベストアンサー

こんばんわ。
こちらでいかがでしょうか。

Sub Test()
Dim AllH, AllF, TitH, TitF, BdyH, BdyF, Br_F, S0, S1 As String
Dim SS As String
Dim I, Imax As Integer
Dim Tmp As Variant

AllH = "<div class=" & Chr(34) & "cntt"">"
AllF = "</div>"
TitH = "<h3>"
TitF = "</h3>"
BdyH = "<p>"
BdyF = "</p>"
Br_F = "<br />"

Tmp = Split(Range("A1"), vbLf)
Imax = UBound(Tmp)

Cells(2, 1) = AllH
For I = 0 To Imax
If Len(Tmp(I)) > 0 Then
If InStr(1, Tmp(I), "◆") > 0 Then
S0 = TitH
S1 = TitF
Else
S0 = BdyH
S1 = BdyF
If I < Imax Then
If Tmp(I + 1) <> "" Then S1 = Br_F
End If
If I > 0 Then
If InStr(1, Tmp(I - 1), Br_F) > 0 Then S0 = ""
End If
End If
Tmp(I) = S0 & Tmp(I) & S1
End If
Cells(I + 3, 1) = Tmp(I)
Next I
Cells(I + 3, 1) = AllF
Range(Cells(2, 1), Cells(I + 3, 1)).Copy
End Sub