帖子: 5
主題: 1
精華: 0
積分: 7
點名: 0
作業系統: WINDOWN7
軟體版本: OFFICE2007
閱讀權限: 10
性別: 男
註冊時間: 2013-10-19
最後登錄: 2023-3-28

1^# 跳轉到 »

發表於 2014-5-15 08:09 | 只看該作者

程式碼是哪裡語法錯誤,要如何修該

請問要從工作表名稱為WebSht中將下載的資料複製至作用的工作表中，以下語法如何修改，謝謝
*資料可依uRng的值來下載資料下來，但就是轉貼不過來。

Dim lastrow&, TT, DD, SS
TT = Left(WebSht.[B4], Len(WebSht.[B4]) - 7) '要從WebSht.[B4]取出字串前半部，"台泥(1101)法人持股明細，其中有")"，所以先取")"之前的半段字串，台泥(1101
DD = Right(TT, Len(uRng)) '再從DD字串取出要用的字串
SS = Left(TT, Len(TT) - Len(uRng) - 1)  '取出其半段，台泥
lastrow = WebSht.[b13].End(xlDown).Row  '算資料列
If DD <> uRng Then Exit Sub  '比對DD字串和uRng的值有相等嗎
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

TOP

owen06

　暱稱: 阿軒

中學生 Rank: 2

帖子: 396
主題: 12
精華: 0
積分: 425
點名: 1
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 20
性別: 男
來自: 台中
註冊時間: 2013-7-2
最後登錄: 2024-8-23

2015羊年全勤獎章 2014馬年全勤獎章熱烈參與勳章

2^#

發表於 2014-5-15 09:42 | 只看該作者

本帖最後由 owen06 於 2014-5-15 09:46 編輯

回復 1# a510684

工作表名稱前面要加sheets("xxx")
如：TT = Left(sheets("WebSht").[B4], Len(sheets("WebSht").[B4]) - 7)

另外可以請問你的urng代表的是什麼嗎？

TOP

a510684

小學生 Rank: 1

帖子: 5
主題: 1
精華: 0
積分: 7
點名: 0
作業系統: WINDOWN7
軟體版本: OFFICE2007
閱讀權限: 10
性別: 男
註冊時間: 2013-10-19
最後登錄: 2023-3-28

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

TOP

a510684

小學生 Rank: 1

帖子: 5
主題: 1
精華: 0
積分: 7
點名: 0
作業系統: WINDOWN7
軟體版本: OFFICE2007
閱讀權限: 10
性別: 男
註冊時間: 2013-10-19
最後登錄: 2023-3-28

4^#

發表於 2014-5-15 13:20 | 只看該作者

剛剛試一下還是不行將web工作表的資料貼到作用的查詢表中，請幫忙，我試了好久，都查不出來

TOP

a510684

小學生 Rank: 1

帖子: 5
主題: 1
精華: 0
積分: 7
點名: 0
作業系統: WINDOWN7
軟體版本: OFFICE2007
閱讀權限: 10
性別: 男
註冊時間: 2013-10-19
最後登錄: 2023-3-28

5^#

發表於 2014-5-15 21:07 | 只看該作者

Sub 載入數據()

Dim Ln As Long, TT, DD, SS As String

Ln = Worksheets("Web").Range("B2000").End(xlUp).Row
TT = Left(Sheets("Web").[B4], Len(Sheets("Web").[B4]) - 7)
SS = Replace(TT, "(", "")
DD = Left(SS, Len(SS) - Len(uRng)) 執行時錯誤顯示為uRng沒有設定物件變數，但前面不適設定過了，有大大要協助幫忙嗎?謝謝
If Right(SS, Len(uRng)) <> uRng Then Exit Sub
uRng(2) = SS
uRng(2, -1).Resize(Ln - 6, 1).Value = Sheets("Web").[B13].Resize(Ln - 6, 1).Value '日期資料欄
uRng(2, 1).Resize(Ln - 6, 10).Value = Sheets("Web").[c12].Resize(Ln - 6, 10).Value '三大法人資料

End Sub

TOP

owen06

　暱稱: 阿軒

中學生 Rank: 2

帖子: 396
主題: 12
精華: 0
積分: 425
點名: 1
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 20
性別: 男
來自: 台中
註冊時間: 2013-7-2
最後登錄: 2024-8-23

2015羊年全勤獎章 2014馬年全勤獎章熱烈參與勳章

6^#

發表於 2014-5-16 12:00 | 只看該作者

回復 5# a510684

請問方便把檔案上傳上來看看嗎？因為這個檔案似乎挺複雜的，
有檔案來實地操作一下應該比較好。

TOP

a510684

小學生 Rank: 1

帖子: 5
主題: 1
精華: 0
積分: 7
點名: 0
作業系統: WINDOWN7
軟體版本: OFFICE2007
閱讀權限: 10
性別: 男
註冊時間: 2013-10-19
最後登錄: 2023-3-28

7^# 倒序看帖

打印

字體大小: tT

發表於 2014-5-16 12:54 | 只看該作者

[發問] 出現"沒有設定物件變數或With區塊變數"錯誤

出現"沒有設定物件變數或With區塊變數"錯誤在紅色字地方，請各位先進幫忙

Dim WebSht As Worksheet, xURL$, GetInfo$, ErrNo, TT As String, DD As String, SS As String, uRng As Range

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
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
102: Beep
End Sub

Sub 載入數據()

Dim Ln As Long

Ln = Worksheets("Web").Range("B2000").End(xlUp).Row
TT = Left(Sheets("Web").[B4], Len(Sheets("Web").[B4]) - 7)
SS = Replace(TT, "(", "")
DD = Left(SS, Len(SS) - Len(uRng))
If Right(SS, Len(uRng)) <> uRng Then Exit Sub
uRng(2) = DD
uRng(2, -1).Resize(Ln - 6, 1) = Sheets("Web").[B13].Resize(Ln - 6, 1).Value '日期資料欄
uRng(2, 1).Resize(Ln - 6, 10) = Sheets("Web").[c12].Resize(Ln - 6, 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

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2014-5-16 15:49 | 只看該作者

本帖最後由 GBKEE 於 2014-5-16 15:52 編輯

回復 7# a510684

Dim WebSht As Worksheet, xURL$, GetInfo$, ErrNo, TT As String, DD As String, SS As String, uRng As Range
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
y = [zz4].End(xlToLeft).Column: If y < 12 Then MsgBox "y < 12": 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
102: Beep
End Sub
Sub 載入數據()
Dim Ln As Long
If uRng Is Nothing Then MsgBox "uRng : 沒有設定物件變數或With區塊變數"
Ln = Worksheets("Web").Range("B2000").End(xlUp).Row
TT = Left(Sheets("Web").[B4], Len(Sheets("Web").[B4]) - 7)
SS = Replace(TT, "(", "")
DD = Left(SS, Len(SS) - Len(uRng))
If Right(SS, Len(uRng)) <> uRng Then Exit Sub
uRng(2) = DD
uRng(2, -1).Resize(Ln - 6, 1) = Sheets("Web").[B13].Resize(Ln - 6, 1).Value '日期資料欄
uRng(2, 1).Resize(Ln - 6, 10) = Sheets("Web").[c12].Resize(Ln - 6, 10).Value '三大法人資料
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP