- 帖子
- 5
- 主題
- 1
- 精華
- 0
- 積分
- 7
- 點名
- 0
- 作業系統
- WINDOWN7
- 軟體版本
- OFFICE2007
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2013-10-19
- 最後登錄
- 2026-4-16
|
3#
發表於 2014-5-15 13:12
| 只看該作者
另外可以請問你的urng代表的是什麼嗎?
urng是代表儲存格中的代號、
Dim WebSht As Worksheet, xURL$, GetInfo$, uRng As Range, ErrNo, LL, RR, CC, TT
Sub 更新全部()
Dim y&, TM, i&
If MsgBox("要全部更新嗎? ", 4 + 32 + 256) = vbNo Then Exit Sub
TM = Time: ErrNo = 0: [A1] = "00:00:00"
[L5:ZZ600].ClearContents: [K6:K600].ClearContents: [L4].Select
Application.ScreenUpdating = False
y = [zz4].End(xlToLeft).Column: If y < 12 Then Exit Sub
For i = 12 To y Step 10
If ErrNo > 0 Then GoTo 102
Set uRng = Cells(4, i)
uRng.Select
If uRng <> "" Then Call 更新Web: Call 載入數據
[A1] = Format(Time - TM, "hh:mm:ss")
Next i
Application.ScreenUpdating = True
102: Beep
End Sub
Sub 載入數據()
Dim lastrow&, TT, DD, SS
TT = Left(WebSht.[B4], Len(WebSht.[B4]) - 7)
DD = Right(TT, Len(uRng))
SS = Left(TT, Len(TT) - Len(uRng) - 1)
lastrow = WebSht.[b13].End(xlDown).Row
If DD <> uRng Then Exit Sub
uRng(2) = SS
uRng(2, -1).Resize(lastrow - 7, 1) = WebSht.[b13].Resize(lastrow - 7, 1).Value '日期資料欄
uRng(2, 1).Resize(lastrow - 7, 10) = WebSht.[c12].Resize(lastrow - 7, 10).Value '三大法人資料
End Sub
Sub 更新Web()
Dim DY1, DY2, DY3, DY4
Application.EnableCancelKey = xlErrorHandler
DY1 = Year(Date) - 1
DY2 = Year(Date)
DY3 = Month(Date)
DY4 = Day(Date)
Set WebSht = Sheets("Web")
WebSht.Cells.Clear
ErrNo = 0
On Error GoTo 101
xURL = "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl.djhtm?a=" & uRng & "&c=" & DY1 & "-" & DY3 & "-" & DY4 & "&d=" & DY2 & "-" & DY3 & "-" & DY4 & ""
With WebSht.QueryTables.Add(Connection:=xURL, Destination:=WebSht.[A1])
.AdjustColumnWidth = False
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
.Delete
End With
Exit Sub
101: ErrNo = Err.Number
End Sub |
|