ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦³Ãö¨Ï¥Î¨Æ¥óµ{§Ç¨ú±o¸ê®Æ(¦³¤G­Ó°ÝÃD)

¦^´_ 1# icestormer
VBAProject
¥D¤u§@ªí
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.   If Application.Intersect(Target, Range("F1:G1")) Is Nothing Then Exit Sub
  3.   UpdatePrice
  4. End Sub
½Æ»s¥N½X
¤@¯ë¼Ò²Õ
  1. Sub UpdatePrice()
  2.   Dim d, rng As Range
  3.   Dim sName As String, sSell As String, sBuy As String
  4.   Dim r As Long, c As Long, x
  5.   
  6.   Const sMark = " - Market Browser"
  7.   Const sMarkSell = "Sell Orders (Buy Orders)"
  8.   Const sMarkBuy = "Buy Orders"
  9.   
  10.   Set d = CreateObject("scripting.dictionary")
  11.   
  12.   With Sheets("¸ê®Æ°Ï")
  13.     For c = 1 To .UsedRange.Columns.Count Step 7  '6Äæ¥[¤WªÅ¥ÕÄæ = 7
  14.       For r = 1 To .Cells(.Rows.Count, c).End(xlUp).Row Step 300 '©T©w300¦C
  15.         sName = "": sSell = "": sBuy = ""
  16.         With .Cells(r, c).Resize(300)
  17.           Set rngName = .Find(sMark, LookIn:=xlValues, lookat:=xlPart)
  18.           If rngName Is Nothing Then GoTo NEXT_BLOCK Else sName = Left(rngName.Value, Len(rngName.Value) - Len(sMark))
  19.          
  20.           Set rng = .Find(sMarkSell, LookIn:=xlValues, lookat:=xlWhole)
  21.           If Not rng Is Nothing Then sSell = rng.Offset(3, 2).Value
  22.          
  23.           Set rng = .Find(sMarkBuy, LookIn:=xlValues, lookat:=xlWhole)
  24.           If Not rng Is Nothing Then sBuy = rng.Offset(3, 2).Value
  25.          
  26.           d(sName) = Array(sSell, sBuy)
  27.         End With
  28. NEXT_BLOCK:
  29.       Next
  30.     Next
  31.   End With
  32.   
  33.   '¶K¤W»ù¦ì
  34.   With Sheets("¥D¤u§@ªí")
  35.     For Each x In .Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp))
  36.       If d.exists(x.Value) Then x.Offset(, 1).Resize(, 2).Value = d(x.Value)
  37.     Next
  38.   End With

  39. End Sub
½Æ»s¥N½X

TOP

¦^´_ 4# icestormer
«ö¤W¤è[§ó·s»ù¦ì]¦r¼Ë(F1 G1Àx¦s®æ)

TOP

¦^´_ 6# icestormer
©Ò¥H§A¸ê®Æªí¬O¦³«Ü¦h«Ü¦h¥~³¡¸ê®Æ³s½u²Õ¦¨¡A¥þ³¡³£§ó·s¤ÓºC©Ò¥H¬O­n§ä¨ì¯S©wªº¥~³¡¸ê®Æ§ó·s³s½u´N¦n¡A
µM«á¦A¨ú¦^¶R½æ»ù¨ì¥D¤u§@ªí¡A¹ï¶Ü¡H

­×§ï¥D¤u§@ªí
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.   If Application.Intersect(Target, Range("F1:G1")) Is Nothing Then Exit Sub
  3.   UpdateQueryTable
  4.   UpdatePrice
  5. End Sub
½Æ»s¥N½X
­ì¥»¤@¯ë¼Ò²Õ¦A¥[¤W:
  1. Sub UpdateQueryTable()
  2.   Dim ar, rng As Range, x
  3.   Dim sMsg As String, bNotFound As Boolean
  4.   
  5.   Const sMark = " - Market Browser"
  6.   sMsg = "¥H¤U§ä¤£¨ì : "
  7.   
  8.   With Sheets("¥D¤u§@ªí")
  9.     ar = Application.Transpose(.Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp)).Value)
  10.   End With
  11.   
  12.   With Sheets("¸ê®Æ°Ï")
  13.     For Each x In ar
  14.       Set rng = .Cells.Find(x & sMark, LookIn:=xlValues, lookat:=xlWhole)
  15.       If rng Is Nothing Then
  16.         sMsg = sMsg & vbCrLf & x & sMark
  17.         bNotFound = True
  18.       Else
  19.         rng.QueryTable.Refresh BackgroundQuery:=False
  20.       End If
  21.     Next
  22.   End With
  23.   
  24.   If bNotFound Then MsgBox sMsg Else MsgBox "Finish"
  25. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2014-1-16 10:20 ½s¿è

¦^´_ 9# icestormer
§ï¤W­±
  With Sheets("¥D¤u§@ªí")
    ar = Application.Transpose(.Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp)).Value)
    If Not IsArray(ar) Then ar = Array(ar)
  End With


¥h±¼ updateprice   ­n¶]®É¦³¿ù»~
¤£À´¡A¤£¥i¯à¨ú®ø©I¥s¨ç¼Æ¤Ï¦Ó²£¥Í¿ù»~

TOP

¦^´_ 13# icestormer
1. FOR°j°éµ²§ô´N¥þ³¡§¹¦¨ªü..
2. ¨S¹J¨ì¡A°j°é¤º¥[­ÓDOEVENTS¬Ý¬Ý

TOP

        ÀR«ä¦Û¦b : ­ì½Ì§O¤H´N¬Oµ½«Ý¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD