データのある所まで指定したい

質問

下記のようにB3からB80までマクロ実行できる様に設定しておきます。
例えばB38までしかデータがない場合、B39でデバッグになってしまいます。
データの入っている所まで実行できるようにお願い致します。

e = 70
*****************************************************
Dim y3 As String
y3 = Range("B3").Value
Dim cp3 As String
cp3 = Range("P3").Value
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & y3, Destination:=Range("E" & e + 1))
.Name = "000"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "" & cp3
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
e = Range("E65536").End(xlUp).Row
******************************************************

　　　　　・
　　　　　・
　　　　　・

******************************************************
Dim y80 As String
y80 = Range("B80").Value
Dim cp80 As String
cp80 = Range("P80").Value
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & y80, Destination:=Range("E" & e + 1))
.Name = "000"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "" & cp80
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
e = Range("E65536").End(xlUp).Row
********************************************************

回答No.3

kmetu · ベストアンサー

Dim y(80) As String
Dim cp(80) As String
Dim i As Integer

e = 70
For i = 3 To Range("B65536").End(xlUp).Row

y(i) = Range("B" & i).Value
cp(i) = Range("P" & i).Value
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & y(i), Destination:=Range("E" & e + 1))
.Name = "000"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "" & cp(i)
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
e = Range("E65536").End(xlUp).Row
Next i

とか…

お礼

再度、回答有難う御座います。

そのままマクロ使用させて頂きます。
追加関連質問ありますが、こちらの質問は一旦閉じさせて頂きます。

新しい質問も回答頂けますと嬉しいです。

回答No.4

imogasi

データ最終行を捉える方法は
（１）Currentregion
（２）UsedRange
（３）End＋↑の操作該当
Sub test02()
MsgBox Range("B65536").End(xlUp).Row
End Sub
（４）編集ージャンプーセル選択ー最後のセルの行
Sub test01()
MsgBox Range("a1:C100").SpecialCells(xlCellTypeLastCell).Row
End Sub
みなくせがある。特徴を捉えて使わないと危ない。
（３）が一番良さそうだが。
ーーー
＞本題マクロとの組合せを書いて頂けますと助かります。
といっているようでは、こんな回答は無駄かな。

お礼

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

回答のような勉強レベルに達しておりません。
参考までとさせて下さい。

回答No.2

cistronezk

マクロは、

Dim y3 As String
y3 = Range("B3").Value
Dim cp3 As String
cp3 = Range("P3").Value
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & y3, Destination:=Range("E" & e + 1))
・・・
End With
e = Range("E65536").End(xlUp).Row

のセットが、B3からB80までの78個あるのですか？お示しのコードでは、たくさん宣言された変数が泣いています。変数は少数精鋭にしてもっと活用してください。たとえば、

Dim b_val As String 'B列のセルの値
Dim p_val As String 'P列のセルの値
Dim e_lastrow As Integer 'E列のデータのある最終行番号
Dim b_rowno As Integer 'B列の処理中の行番号
For b_rowno = 3 To 80
b_val = Range("B" & b_rowno).Value
'b_rowno行に「http・・・」というデータがあるときだけクエリを実行。
If InStr(b_val,"http") > 0 Then
e_lastrow = Range("E65536").End(xlUp).Row
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & y_val, Destination:=Range("E" & (e_lastrow + 1)))
・・・
.WebTables = "" & p_val
・・・
End With
End If
Next

という感じです。

●変更した変数
「y3」などー＞「b_val」'B列のセルの値
「cp3」などー＞「p_val」'P列のセルの値
「e」ー＞「e_lastrow」'E列のデータのある最終行番号

＞例えばB38までしかデータがない場合、B39でデバッグになってしまいます。
これに対応するために、B列の値に「http・・・」という文字がある場合だけクエリを実行するように、以下のIf文を追加しました。
If InStr(y_val,"http") > 0 Then
・・・
End If

●For文については、WEBや書籍などを参考にしてください。
For文を覚えるとプログラムがすっきりして見通しが良くなる（バグが入り込む可能性が減る）ので、ぜひ身に付けてください。

補足

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

e = 70
Dim b_val As String 'B列のセルの値
Dim p_val As String 'P列のセルの値
Dim e_lastrow As Integer 'E列のデータのある最終行番号
Dim b_rowno As Integer 'B列の処理中の行番号
For b_rowno = 3 To 80
b_val = Range("B" & b_rowno).Value
'b_rowno行に「http・・・」というデータがあるときだけクエリを実行。
If InStr(b_val,"http") > 0 Then
e_lastrow = Range("E65536").End(xlUp).Row
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & y_val, Destination:=Range("E" & (e_lastrow + 1)))
.Name = "000"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "" & p_val
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

End If
Next

の
"URL;" & y_val, Destination:=Range("E" & (e_lastrow + 1)))
　　　　　　↓
"URL;" & b_val, Destination:=Range("E" & (e_lastrow + 1)))
として実行しましたが何も表示されませんでした。

再度、見て頂けますと助かります。

回答No.1

kmetu

各変数を配列にして

For i=3 to Range("B65536").End(xlUp).Row
y(i) = Range("B" & i).Value
cp(i) = Range("P" & i).Value
中略
e = Range("E65536").End(xlUp).Row
Next i

にすればいかがでしょう。

お礼

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

素人ですので、本題マクロとの組合せを書いて頂けますと助かります。