| |
>ThisWorkbook.Names.Count
というのは、[名前の定義]の個数です。
15171個は多いですね。
Webクエリでデータを取得した後、クエリの定義はどうされるのでしょう？
一度設定して、後は更新ですか？
それとも Cells(lastrow, 2) という指定から推測すると、
毎回、ご提示のコードでWebクエリを実行されているのですか？
『もし、そうであれば、』必要なものはデータのみなので、
データ取得直後にWebクエリ定義を削除するようにしてはどうでしょう。
また、クエリはクエリ定義と名前定義を行いますから、それも削除する必要があります。
具体的には
> .Refresh BackgroundQuery:=False
.Parent.Names(.Name).Delete
.Delete
> End With
>End Sub
この２行を追加します。
また、今まで溜まった[名前定義]を削除したほうが良いでしょう。
（他に、必要な[名前定義]がなければの話ですが）
Sub try()
Dim n As Name
With ActiveWorkbook
For Each n In .Names
n.Delete
Next
MsgBox .Names.Count
End With
End Sub
※該当BookをActiveにして実行してください。
※念の為バックアップをとっておいてくださいね。
>IEオブジェクトを使う方法
は以前書いたサンプルがあったので載せておきますね。
Sub sample()
Const READYSTATE_COMPLETE As Long = 4
Const sCHK As String = "日付始値高値"
Dim sURL(0 To 9) As String
Dim x As Object
Dim i As Long
Dim j As Long
Dim n As Long
'ｈｔｔｐは半角で。
sURL(0) = "ｈｔｔｐ://table.yahoo.co.jp/t?"
sURL(1) = "c=2007"
sURL(2) = "a=11"
sURL(3) = "b=1"
sURL(4) = "f=2007"
sURL(5) = "d=11"
sURL(6) = "e=30"
sURL(7) = "g=d"
sURL(8) = "s=6758"
With CreateObject("InternetExplorer.Application")
.Visible = True
.navigate Join(sURL, "&")
While .busy Or (.readyState <> READYSTATE_COMPLETE)
DoEvents
Wend
For Each x In .document.getElementsByTagName("TABLE")
If Left(x.innertext, 6) Like sCHK Then
If x.Rows(0).Cells.Length = 7 Then Exit For
End If
Next x
If Not x Is Nothing Then
n = x.Rows.Length
ReDim v(n - 1, 6)
For i = 0 To n - 1
For j = 0 To 6
v(i, j) = x.Rows(i).Cells(j).innertext
Next j
Next i
Set x = Nothing
Sheets.Add
Range("A1:G1").Resize(n).Value = v
End If
.Quit
End With
MsgBox "finish"
End Sub
（"TABLE"名が取れたらもっと簡単になるのかもしれません。
その辺りはよくわかりませんでした）
>CPUの稼働率が100%
あと、シート上にグラフを配置して、その上に[図のコピー]で作成したShapeを使ったりはしていませんか？
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
