エクセル マクロ ループで？

質問

度々すいません。マクロはほぼ初心者ですがよろしくお願いします。

前回の質問で、ある程度教えていただいたのですがループさせる方法がよくわかりません。

http://okwave.jp/qa4469670.html

サンプルでコードは

Sub test()
　Dim st As String, s As String, stmp As String
　Dim sht As Worksheet, rw As Long, col As Long

　st = "<div align='center'><b>$4</b></div>@<div align='center'><a rel='nofollow' href='$8'><img src='$9' border='0' alt='$3'></a></div>@<div align='center'><a rel='nofollow' href='$8'>$3</a></div>@$5@$6@<!--$1$2-->"
　st = Replace(Replace(st, "@", Chr(10), 1, -1, 1), "'", Chr(34), 1, -1, 1)

　Set sht = ActiveSheet '//現在のシートを設定

'------- 1行分の処理　----
　rw = 2 '//処理対象の行番号（2行目に設定）
　s = st '//雛型の文字をコピー
　For col = 1 To 9 '//A～I列までをループ（col=列番号）
　　stmp = "$" & Format(col, "#")
　　 '//各セルの内容で置換え
　　s = Replace(s, stmp, sht.Cells(rw, col).Text, 1, -1, 1)
　Next col
　sht.Cells(rw, 14).Value = s '//結果をN列に入れる

End Sub

です。

マクロを実行するとセルN2に出力されます。これをN2以降、N3N4・・・も表示されるようにしたいです。

rw = 2 '//処理対象の行番号（2行目に設定）を固定させないでループすればいいようなのですが、どのようにすればいいのでしょうか？

Sub test()～End Sub内全てを教えていただけないでしょうか？

よろしくお願いします。

回答No.5

lul · ベストアンサー

これで少しは分かりやすくなるのではないでしょうか？
Sub test2()
Const LFeed As String = vbCrLf
Dim st As String
Dim sht As Worksheet, i As Long, obj
Set sht = ActiveSheet '//現在のシートを設定
Dim MaxRow As Long
MaxRow = Range("A65536").End(xlUp).Row
For i = 1 To MaxRow
If Cells(i, 1) <> "" Then
Set Grammar = Nothing
'HTML1行ずつ記載しています
st = ""
st = "<div align='center'><b>" & Cells(i, 4) & "</b></div>" & LFeed
st = st & "<div align='center'><a rel='nofollow' href='" & Cells(i, 8) & "'><img src='" & Cells(i, 9) & "' border='0' alt='" & Cells(i, 3) & "'></a></div>" & LFeed
st = st & "<div align='center'><a rel='nofollow' href='" & Cells(i, 8) & "'>" & Cells(i, 3) & "</a></div>" & LFeed
st = st & Cells(i, 5) & LFeed
st = st & Cells(i, 6) & LFeed
st = st & "<!--" & Cells(i, 1) & Cells(i, 2) & "-->"

st = Replace(st, "'", Chr(34), 1, -1, 1)
sht.Cells(i, 14).Value = Mid(st, 1, Len(st) - 1) '//結果をN列に入れる
End If
Next i
End Sub
"(ダブルクォート)はやはり'(シングルクォート)で記載して後で置換える方が良いと思います。
他にもCollectionオブジェクトや、Textstreamオブジェクトを使うのも手ですが、今回は一番単純に分かりやすくなるように書いてます。
もっと分かりやすくする為にはHTMLの構文の所を設定ファイルとして外部で持って、それを読み込んで使うというのもありだと思うし、色々やり方はありますね。
後々楽に作業できるようにする為にも頑張ってくださいね。

お礼

lulさん
ご回答大変ありがとうございます。
これで、思うような事ができます。
本当にありがとうございました。

回答No.4

pkh4989

こんにちは。
以下のマクロを試してみてください。

Sub test()
　　Dim st As String, s As String, stmp As String
　　Dim sht As Worksheet, rw As Long, col As Long
　　Dim MaxRow As Long

　　With ActiveSheet　　'//現在のシートを設定
　　　　MaxRow = .Range("A" & Rows.Count).End(xlUp).Row
　　　　For rw = 1 To MaxRow
　　　　　　If Cells(rw, "A") <> "" Then
　　　　　　　　'//雛型の文字を設定
　　　　　　　　st = "<div align=""center""><b>"
　　　　　　　　st = st & .Range("D" & rw) & "</b></div>@"
　　　　　　　　st = st & "<div align=""center""><a rel=""nofollow"" href="""
　　　　　　　　st = st & .Range("H" & rw) & """><img src="""
　　　　　　　　st = st & .Range("I" & rw) & """ border=""0"" alt="""
　　　　　　　　st = st & .Range("C" & rw) & """></a></div>@<div align=""center""><a rel=""nofollow"" href="""
　　　　　　　　st = st & .Range("H" & rw) & """>"
　　　　　　　　st = st & .Range("C" & rw) & "</a></div>@"
　　　　　　　　st = st & .Range("E" & rw) & "@" & .Range("F" & rw) & "@"
　　　　　　　　st = st & "<!--" & .Range("A" & rw) & .Range("B" & rw) & "-->"
　　　　　　　　st = Replace(Replace(st, "@", Chr(10), 1, -1, 1), "'", Chr(34), 1, -1, 1)
　　　　　　　　s = st '//雛型の文字をコピー
　　　　　　　　For col = 1 To 9　　'//A～Iカラムまでをループ（col=列番号）
　　　　　　　　　　stmp = "$" & Format(col, "#")
　　　　　　　　　　'//各セルの内容で置換え
　　　　　　　　　　s = Replace(s, stmp, .Cells(rw, col).Text, 1, -1, 1)
　　　　　　　　Next
　　　　　　　　.Cells(rw, "N").Value = s '//結果をN列に入れる
　　　　　　End If
　　　　Next
　　End With
End Sub

回答No.3

lul

こんにちは
以下のコードでご希望の処理になるのではないでしょうか。
Sub test()
Dim st As String, s As String, stmp As String
Dim sht As Worksheet, rw As Long, col As Long
Dim MaxRow As Long
MaxRow = Range("A65536").End(xlUp).Row
st = "<div align='center'><b>$4</b></div>@<div align='center'><a rel='nofollow' href='$8'><img src='$9' border='0' alt='$3'></a></div>@<div align='center'><a rel='nofollow' href='$8'>$3</a></div>@$5@$6@<!--$1$2-->"
st = Replace(Replace(st, "@", Chr(10), 1, -1, 1), "'", Chr(34), 1, -1, 1)

Set sht = ActiveSheet '//現在のシートを設定
For rw = 1 To MaxRow
If Cells(rw, 1) <> "" Then
'------- 1行分の処理　----
s = st '//雛型の文字をコピー
For col = 1 To 9 '//A～I列までをループ（col=列番号）
stmp = "$" & Format(col, "#")
'//各セルの内容で置換え
s = Replace(s, stmp, sht.Cells(rw, col).Text, 1, -1, 1)
Next col
sht.Cells(rw, 14).Value = s '//結果をN列に入れる
End If
Next rw
End Sub
他の回答者様のを少しいじっただけですが…。

お礼

ご回答ありがとうございまいした。

思うように出来て大変感謝しています。

また、質問ついでにお聞きしたいのですがよろしいでしょうか？

st = "<div align='center'><b>$4</b></div>@<div align='center'><a rel='nofollow' href='$8'><img src='$9' border='0' alt='$3'></a></div>@<div align='center'><a rel='nofollow' href='$8'>$3</a></div>@$5@$6@<!--$1$2-->"

これなんですが、今回はテンプレートが短かった為これでもいいのですが、複雑な物になると分かりにくいです。

そこで
print "・・" & range("？") & "・・・"
print "・・" & range("？") & "・・・"
print "・・" & range("？") & "・・・"

このようにする場合はどのようにすればいいでしょうか？

回答No.2

pkh4989

(1) 最後に以下の1行を追加するか
　'
　sht.Range("N" & rw & ":N100").FillDown '←追加 (N2～N100まで)

(2) For で回すなら以下のようにしてください。

Sub test()
　Dim st As String, s As String, stmp As String
　Dim sht As Worksheet, rw As Long, col As Long

　st = "<div align='center'><b>$4</b></div>@<div align='center'><a rel='nofollow' href='$8'><img src='$9' border='0' alt='$3'></a></div>@<div align='center'><a rel='nofollow' href='$8'>$3</a></div>@$5@$6@<!--$1$2-->"
　st = Replace(Replace(st, "@", Chr(10), 1, -1, 1), "'", Chr(34), 1, -1, 1)

　Set sht = ActiveSheet '//現在のシートを設定

　s = st '//雛型の文字をコピー
　For rw = 2 To 100　'←追加 (2～100行分の処理)
　　For col = 1 To 9 '//A～Iカラムまでをループ（col=列番号）
　　　stmp = "$" & Format(col, "#")
　　　'//各セルの内容で置換え
　　　s = Replace(s, stmp, sht.Cells(rw, col).Text, 1, -1, 1)
　　Next
　　sht.Cells(rw, 14).Value = s '//結果をN列に入れる
　Next
End Sub

補足

pkh4989さん
ご回答ありがとうございます。

今、試してみましたが失敗しました。
これで試すとN2N3N4・・・のセルは全て同じ内容が表示されてしまいます。

また（１）で試した方のが処理スピードが速い感じでした。

●ちょっとしつこいようですが、もう一度質問を書いておきます。
----------------------------------------------------------------
エクセルにはセルA～Mまでデータが入っています。（件数的にはかなりの量です）

そこでマクロを使ってセルＮ内に以下のようなHTMLを入れたいです。

<div align="center"><b>【Dのセル】</b></div>
<div align="center"><a rel="nofollow" href="【Hのセル】"><img src="【Iのセル】" border="0" alt="【Cのセル】"></a></div>
<div align="center"><a rel="nofollow" href="【Hのセル】">【Cのセル】</a></div>
【Eのセル】
【Fのセル】
<!--【Aのセル】【Bのセル】-->
----------------------------------------------------------------
A～Mにデータが入っている行はＮ列に表示、A～Mにデータが入っていない場合は表示されないようにしたいです。

よろしくお願いします。

回答No.1

n-jun

Sub Try()
Dim rw As Long, col As Long

For rw = 2 To 1000 '１０００行目までとして
For col = 1 To 9 '９列目までとして

Cells(rw, col).Value = "abc"

Next col
Next rw
End Sub

２行目から１０００行目までの、１列目から９列目まで"abc"を代入してます。
ご参考程度に。