みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

下記のように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
********************************************************

投稿日時 - 2009-08-13 16:41:40

QNo.5204427

困ってます

質問者が選んだベストアンサー

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

とか…

投稿日時 - 2009-08-13 21:33:20

お礼

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

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

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

投稿日時 - 2009-08-13 22:19:50

ANo.3

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

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

投稿日時 - 2009-08-13 21:47:32

お礼

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

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

投稿日時 - 2009-08-13 22:15:03

ANo.2

マクロは、

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文を覚えるとプログラムがすっきりして見通しが良くなる(バグが入り込む可能性が減る)ので、ぜひ身に付けてください。

投稿日時 - 2009-08-13 18:07:40

補足

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

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)))
として実行しましたが何も表示されませんでした。

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

投稿日時 - 2009-08-13 20:32:47

ANo.1

各変数を配列にして

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

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

投稿日時 - 2009-08-13 17:19:48

お礼

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

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

投稿日時 - 2009-08-13 20:43:26

あなたにオススメの質問