[發問] 有關使用事件程序取得資料(有二個問題)

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

2^#

發表於 2014-1-15 13:54 | 只看該作者

回復 1# icestormer
VBAProject
主工作表

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, Range("F1:G1")) Is Nothing Then Exit Sub
UpdatePrice
End Sub

複製代碼

一般模組

Sub UpdatePrice()
Dim d, rng As Range
Dim sName As String, sSell As String, sBuy As String
Dim r As Long, c As Long, x
Const sMark = " - Market Browser"
Const sMarkSell = "Sell Orders (Buy Orders)"
Const sMarkBuy = "Buy Orders"
Set d = CreateObject("scripting.dictionary")
With Sheets("資料區")
For c = 1 To .UsedRange.Columns.Count Step 7 '6欄加上空白欄 = 7
For r = 1 To .Cells(.Rows.Count, c).End(xlUp).Row Step 300 '固定300列
sName = "": sSell = "": sBuy = ""
With .Cells(r, c).Resize(300)
Set rngName = .Find(sMark, LookIn:=xlValues, lookat:=xlPart)
If rngName Is Nothing Then GoTo NEXT_BLOCK Else sName = Left(rngName.Value, Len(rngName.Value) - Len(sMark))
Set rng = .Find(sMarkSell, LookIn:=xlValues, lookat:=xlWhole)
If Not rng Is Nothing Then sSell = rng.Offset(3, 2).Value
Set rng = .Find(sMarkBuy, LookIn:=xlValues, lookat:=xlWhole)
If Not rng Is Nothing Then sBuy = rng.Offset(3, 2).Value
d(sName) = Array(sSell, sBuy)
End With
NEXT_BLOCK:
Next
Next
End With
'貼上價位
With Sheets("主工作表")
For Each x In .Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp))
If d.exists(x.Value) Then x.Offset(, 1).Resize(, 2).Value = d(x.Value)
Next
End With
End Sub

複製代碼

帖子: 127
主題: 28
精華: 0
積分: 160
點名: 0
作業系統: W7
軟體版本: 2003
閱讀權限: 20
性別: 男
註冊時間: 2010-11-1
最後登錄: 2017-5-20

3^#

發表於 2014-1-15 14:01 | 只看該作者

回復 2# stillfish00

感恩我去試試!

帖子: 127
主題: 28
精華: 0
積分: 160
點名: 0
作業系統: W7
軟體版本: 2003
閱讀權限: 20
性別: 男
註冊時間: 2010-11-1
最後登錄: 2017-5-20

4^#

發表於 2014-1-15 14:12 | 只看該作者

回復 3# icestormer

你好程序會很順利的跑完但他不會更新呢,SORRY我沒有說明白我是用下方指令這種來更新

Selection.QueryTable.Refresh BackgroundQuery:=False

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

5^#

發表於 2014-1-15 14:51 | 只看該作者

回復 4# icestormer
按上方[更新價位]字樣(F1 G1儲存格)

帖子: 127
主題: 28
精華: 0
積分: 160
點名: 0
作業系統: W7
軟體版本: 2003
閱讀權限: 20
性別: 男
註冊時間: 2010-11-1
最後登錄: 2017-5-20

6^#

發表於 2014-1-15 18:08 | 只看該作者

本帖最後由 icestormer 於 2014-1-15 18:21 編輯

回復 5# stillfish00

那個好像你誤會我的意思了

我再試者說明一次主要是資料會有2 到3千筆但是每次我也許只要更新其中1到3百筆(每種每次更新時種類不同)

我按下更新價位時他好像只會更新主工作表上的B2到C4(目前上頭只有3筆資料)而不會去更新資料區內的如下圖

我想一個程式在我按下[更新市價]時它會自動按[主工作表]上A2到AXXX(看有幾筆)
每一筆上的物品名稱(例如:Pyerite)去找到資料區內進而更新它 ,然後由於資料量大所以他可能會A那或是H或是更遠的AC300那裡
如果全部資料都在同一行(A1:A65536)那我還寫的出來但資料會分散開所以寫不出來><
再次感謝你的回覆!

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

7^#

發表於 2014-1-15 20:16 | 只看該作者

回復 6# icestormer
所以你資料表是有很多很多外部資料連線組成，全部都更新太慢所以是要找到特定的外部資料更新連線就好，
然後再取回買賣價到主工作表，對嗎？

修改主工作表

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.Intersect(Target, Range("F1:G1")) Is Nothing Then Exit Sub
UpdateQueryTable
UpdatePrice
End Sub

複製代碼

原本一般模組再加上:

Sub UpdateQueryTable()
Dim ar, rng As Range, x
Dim sMsg As String, bNotFound As Boolean
Const sMark = " - Market Browser"
sMsg = "以下找不到 : "
With Sheets("主工作表")
ar = Application.Transpose(.Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp)).Value)
End With
With Sheets("資料區")
For Each x In ar
Set rng = .Cells.Find(x & sMark, LookIn:=xlValues, lookat:=xlWhole)
If rng Is Nothing Then
sMsg = sMsg & vbCrLf & x & sMark
bNotFound = True
Else
rng.QueryTable.Refresh BackgroundQuery:=False
End If
Next
End With
If bNotFound Then MsgBox sMsg Else MsgBox "Finish"
End Sub

複製代碼

帖子: 127
主題: 28
精華: 0
積分: 160
點名: 0
作業系統: W7
軟體版本: 2003
閱讀權限: 20
性別: 男
註冊時間: 2010-11-1
最後登錄: 2017-5-20

8^#

發表於 2014-1-15 20:38 | 只看該作者

回復 7# stillfish00

對沒錯不然我只要看300筆但一次全部更新3千筆...這..太沒花時間也沒必要感謝我試試!^^

帖子: 127
主題: 28
精華: 0
積分: 160
點名: 0
作業系統: W7
軟體版本: 2003
閱讀權限: 20
性別: 男
註冊時間: 2010-11-1
最後登錄: 2017-5-20

9^#

發表於 2014-1-16 09:49 | 只看該作者

本帖最後由 icestormer 於 2014-1-16 09:53 編輯

回復 8# icestormer

你好我一開始試都OK(有3筆) 然後呢我發現當只有一筆資料時(如上圖)就會發生錯誤只要有2筆以上資料就不會出錯不知要修改那裡呢?

另外我把那一行去掉 updateprice 要跑時有錯誤

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

10^#

發表於 2014-1-16 10:18 | 只看該作者

本帖最後由 stillfish00 於 2014-1-16 10:20 編輯

回復 9# icestormer
改上面
With Sheets("主工作表")
ar = Application.Transpose(.Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp)).Value)
If Not IsArray(ar) Then ar = Array(ar)
End With

去掉 updateprice 要跑時有錯誤
不懂，不可能取消呼叫函數反而產生錯誤