ＥＸＣＥＬ ＶＢＡ データのある範囲の特定が悪い？

質問

アンケート調査票を簡単につくために、下のようなマクロを教えていただいたのですが、もとデータ項目の参照範囲がセルのＢ５より上にあるもの（空白の場合も）も項目としてしまっているようなので、どこを手直しすればいいのか、すみませんが教えてください。

Sub test()

'定数の設定
Const strInputSheet As String = "Sheet1"
Const lngInputRow As Long = 5
Const lngInputCol As Long = 2
Const strOutputSheet As String = "Sheet2"
Const lngOutputCol As Long = 3
Const lngOutputRow As Long = 4

Const strMessageA As String = " は "
Const strMessageB As String = " に対してどの位影響があると思いますか？"

'定義
Dim lngMaxRow As Long
Dim lngCountA As Long
Dim lngCountB As Long
Dim strA As String
Dim strB As String
Dim lngRow As Long

'項目数を把握
Sheets(strInputSheet).Select
Cells(ActiveSheet.Rows.Count, lngInputCol).Select
Selection.End(xlUp).Select

lngMaxRow = Selection.Row 'Ｂ列のデータ最終行を取得
lngRow = lngOutputRow '出力開始行の設定

'項目Aをなめる
For lngCountA = lngInputRow To lngMaxRow
　strA = Cells(lngCountA, lngInputCol).Value '項目Aの取得

　'項目Bをなめる
　For lngCountB = 1 To lngMaxRow

　　If lngCountA <> lngCountB Then '項目Aと項目Bが同じときはここは処理しない
　　　strB = Cells(lngCountB, lngInputCol).Value '項目Bを取得
　　　Sheets(strOutputSheet).Cells(lngRow, lngOutputCol).Value = strA & strMessageA & strB & strMessageB '文字列を結合
　　　lngRow = lngRow + 1 '改行する
　　End If

　Next lngCountB
Next lngCountA

End Sub

回答No.1

happypoint · ベストアンサー

こんにちは。

　'項目Bをなめる
　For lngCountB = 1 To lngMaxRow

の行を、

　'項目Bをなめる
　For lngCountB = lngInputRow To lngMaxRow

に変えてみてください。

お礼

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