- 帖子
- 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
|
|
