麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 有關使用事件程序取得資料(有二個問題) [打印本頁]

作者: icestormer 時間: 2014-1-14 12:30 標題: 有關使用事件程序取得資料(有二個問題)

本帖最後由 icestormer 於 2014-1-14 12:33 編輯

上圖是利用A2的物品名稱去找到資料區內的賣價但現在是買價的公式寫不出來~~

下圖是各種物品資料由於紅圈處資料筆數不同所以不知應要怎寫公式讓EXCEL能取得　買價的價位（已附上檔案）
如果我有說明不清的地方，請見諒～～　

[attach]17257[/attach]

作者: stillfish00 時間: 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

複製代碼

作者: icestormer 時間: 2014-1-15 14:01

回復 2# stillfish00

感恩我去試試!

作者: icestormer 時間: 2014-1-15 14:12

回復 3# icestormer

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

Selection.QueryTable.Refresh BackgroundQuery:=False

作者: stillfish00 時間: 2014-1-15 14:51

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

作者: icestormer 時間: 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)那我還寫的出來但資料會分散開所以寫不出來><
再次感謝你的回覆!

作者: stillfish00 時間: 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

複製代碼

作者: icestormer 時間: 2014-1-15 20:38

回復 7# stillfish00

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

作者: icestormer 時間: 2014-1-16 09:49

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

回復 8# icestormer

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

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

作者: stillfish00 時間: 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 要跑時有錯誤
不懂，不可能取消呼叫函數反而產生錯誤

作者: icestormer 時間: 2014-1-16 10:29

回復 10# stillfish00

感謝!

作者: icestormer 時間: 2014-1-16 10:55

回復 stillfish00

感謝!
icestormer 發表於 2014-1-16 10:29

已完全沒有問題..我再多試感謝的幫忙^^

作者: icestormer 時間: 2014-1-24 14:10

本帖最後由 icestormer 於 2014-1-24 14:19 編輯

回復 icestormer
改上面
With Sheets("主工作表")
ar = Application.Transpose(.Range(.Range(" ...
stillfish00 發表於 2014-1-16 10:18

你好由於發現另一個問題但不知怎寫又來請教你了
我想使用下面程式碼讓它自動重算(我把它改成手動的)
'
Application.MaxChange = 0.001
ActiveWorkbook.PrecisionAsDisplayed = False
Calculate
由於資料在更新時會有2 300筆不知應怎樣寫讓程式判定已停止更新(全部已更新完成) 再執行上述程式碼呢? 麻煩你了

另外不知為什麼只要更新超過十多筆就會出再現如下圖的情況,要等到更新完成才會回復正常 ,但這正常嗎??

作者: stillfish00 時間: 2014-1-26 07:29

回復 13# icestormer
1. FOR迴圈結束就全部完成阿..
2. 沒遇到，迴圈內加個DOEVENTS看看

作者: icestormer 時間: 2014-1-26 09:47

回復 14# stillfish00

好感謝我去試試

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)