実行時エラー'1004': アプリケーション定義またはオブジェクト定義

質問

実行時エラー'1004': アプリケーション定義またはオブジェクト定義について
Dim code As String
Dim lastrow As Integer
Dim i As Integer
Sub calc()
Dim code As String
Dim day_s As Integer, month_s As Integer, year_s As Integer
Dim day_e As Integer, month_e As Integer, year_e As Integer
Dim row_length As Integer
code = "998407.o"
day_e = 31
month_e = 12
year_e = 2005
day_s = 1
month_ = 1
year_s = 2005
Range("B4:H65536").ClearContents
For i = 0 To 365 * 0.65 Step 50
URL = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv"
If i = 0 Then
lastrow = 4
Call GETデータ
If Range("B4") = "" Then
Exit Sub
End If
Else
lastrow = Range("B4").End(xlDown).Row + 1
Call GETデータ
Range("B" & lastrow, "H" & lastrow).Delete
row_length = Range("B4").End(xlDown).Row
If row_length - lastrow < 49 Then
Exit For
End If
End If
Next
Range("B5:H65536").Sort key1:=Columns("B")
lastrow = Range("B4").End(xlDown).Row
Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd"
Range("A1").Select
End Sub
もうひとつ
Sub GETデータ()
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Cells(lastrow, 2))
↑ここにデバックで黄色になります。
.Name = "t?s=998407.o&g=d"
.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 = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End　Subになります。Excel２００７です。

回答No.3

jcctaira · ベストアンサー

多分、変数の定義がきちんとできていないと思います。

「Sub calc()」で
　URL = "URL;http://table.yahoo.co.jp/t?s="………
　を設定していますが、

「Sub GETデータ」では
　ActiveSheet.QueryTables.Add(Connection:=URL………

URL変数はどこにも定義していませんので、どちらのサブルーチンも個別の変数（ローカル変数）
になっています。
よって「Sub GETデータ」のURLは空文字のままです。

もしURLをモジュール変数かパブリック変数またはURLを受け渡せば良いかと思います。

【モジュール変数なら】
　　Dim i As Integer
　　Dim URL As String　　　　←追加
　　Sub calc()

【パブリック変数なら】
　　Dim i As Integer
　　Public URL As String　　　　←追加
　　Sub calc()

【変数の受け渡し】
　　Call GETデータ(URL)
　　　　　:
　　　　　:
　　Sub GETデータ(URL)

お礼

ありがとうございました。解決しました。著書のホームページを検索してみたところ、がっつり正誤表が記載されておりました。やれやれです。ありがとうございました。

回答No.2

Wendy02

訂正する部分としては、上から順です。

'//
Dim lastrow As Integer
　　↓
Dim lastrow As Long　 '任意です。

'//
Call GETデータ
　　↓
Call GETデータ(URL, lastrow)

'//
Sub GETデータ()
　　↓
Sub GETデータ(ByVal URL, ByVal lastrow As Long)

'//
　.Refresh BackgroundQuery:=False
　End With
End Sub
　　↓
　.Refresh BackgroundQuery:=False
　End With
　ActiveSheet.QueryTables(1).Delete '任意です。
End Sub

お礼

ありがとうございます。解決しました。

回答No.1

mo2yakko

私のはEXCEL2003なのでよく判りませんが
URLという変数はどこで宣言していますか？
していない場合、ローカル変数と判断されているため
GETデータで使用している変数URLがNULL（空白文字）
になっているんじゃないでしょうか？

Option Explicitを付けて、デバッグしてみましょう。

Option Explicit '追加
Dim URL As String '追加
Dim code As String
Dim lastrow As Integer
Dim i As Integer

Sub calc()
:
:
End Sub

補足

ご教授ありがとうございます。今やってみたところ変わらず同じ場所がエラーです。
Dim i As Long
Dim URL As String
Dim code As String
Option Explicit
Dim lastrow As Integer

Sub calc()
Dim code As String
Dim day_s As Integer, month_s As Integer, year_s As Integer
Dim day_e As Integer, month_e As Integer, year_e As Integer
Dim row_length As Integer
code = "998407.o"
day_e = 31
month_e = 12
year_e = 2005
day_s = 1
month_s = 1
year_s = 2005
Range("B4:H65536").ClearContents
For i = 0 To 365 * 0.65 Step 50
URL = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv"
If i = 0 Then
lastrow = 4
Call GETデータ

If Range("B4") = "" Then
Exit Sub
End If
Else
lastrow = Range("B4").End(xlDown).Row + 1
Call GETデータ

Range("B" & lastrow, "H" & lastrow).Delete
row_length = Range("B4").End(xlDown).Row
If row_length - lastrow < 49 Then
Exit For
End If
End If
Next
Range("B5:H65536").Sort key1:=Columns("B")
lastrow = Range("B4").End(xlDown).Row
Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd"
Range("A1").Select
End Sub
で
Sub GETデータ()
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Cells(lastrow, 2))
.Name = "t?s=998407.o&g=d"
.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 = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.Refresh BackgroundQuery:=False
　　　　 End With
　　　　　　　End Sub
何か間違っているところはありますでしょうか？初心者で困り果てています。