Board logo

標題: [發問] 程序沒問題，答案郤有問題???? [打印本頁]
作者: t8899    時間: 2014-10-28 20:46     標題: 程序沒問題，答案郤有問題????

程序跟來源沒問題，答案郤有問題????[attach]19418[/attach]
作者: luhpro    時間: 2014-10-28 23:36

本帖最後由 luhpro 於 2014-10-28 23:38 編輯
程序跟來源沒問題，答案郤有問題????
t8899 發表於 2014-10-28 20:46

兩個癥結點:
1. Range 的 find 函數只能找到第 1 個符合條件的儲存格(假設為 a),
若要找第 2 個符合條件的儲存格則搜尋範圍要改成從 a 的下一格開始找起.

2. Find 函數要用  LookAt:=xlWhole(此非預設值) 才是找 "整個儲存格都符合條件" 的儲存格.
故程式改為:
Dim a, b, K, c
Set a = [a1]  ' 因底下 IIF 中  a.Offset(1) 此項會執行計算, 故須先定義 a 的初值,否則會有錯誤.
For K = 1 To 50
b = Application.Large(Range("g2:g857"), K)
If Not IsNumeric(b) Then GoTo 110
Set a = Range(IIf(c = b, a.Offset(1), Range("g2")), [g857]).Find(What:=b, LookIn:=xlValues, LookAt:=xlWhole)
...
c = b
End If
Next
...
作者: t8899    時間: 2014-10-29 06:10

兩個癥結點:
1. Range 的 find 函數只能找到第 1 個符合條件的儲存格(假設為 a),
若要找第 2 個符合條件 ...
luhpro 發表於 2014-10-28 23:36


Set a = Range(IIf(c = b, a.Offset(1), Range("g2")), [g857])
此處需要物件??
作者: GBKEE    時間: 2014-10-29 13:47

本帖最後由 GBKEE 於 2014-10-29 13:50 編輯

回復 3# t8899
Large函數 不是真的傳回數值資料中的第幾大
  1. Sub EX()
  2.     Dim AR, k
  3.     AR = Array(5, 5, 6, 6, 7, 7, 8)
  4.    ' AR = Array(5, 6, 7, 5, 6, 7, 8)
  5.     For k = 1 To UBound(AR) + 1
  6.     MsgBox "第 " & k & " 大 : " & Application.Large(AR, k)
  7.     Next
  8. End Sub
複製代碼
須修改一下
  1. Option Explicit
  2. Dim D As Object
  3. Private Sub CommandButton1_Click()
  4.     Range("K3:S" & Rows.Count).ClearContents
  5.     Dim a As Range, b As Long, k As Integer, aD As String
  6.     排序值 Range("g2:g857")
  7.     For k = 1 To IIf(D.Count >= 50, 50, D.Count)
  8.         b = Application.Large(D.KEYS, k)
  9.         Set a = Range("g2:g857").Find(What:=b, LookIn:=xlValues, lookat:=xlWhole)
  10.         If Not a Is Nothing Then aD = a.Address
  11.         Do While Not a Is Nothing
  12.             Range("K100").End(xlUp).Offset(1) = a.Offset(0, -6) '代號
  13.             Range("L100").End(xlUp).Offset(1) = a.Offset(0, -5) '名稱
  14.             Range("M100").End(xlUp).Offset(1) = a.Offset(0, 0) ' 張
  15.             Range("N100").End(xlUp).Offset(1) = a.Offset(0, -4) '價位
  16.             Set a = Range("g2:g857").FindNext(a)
  17.             If a.Address = aD Then Exit Do
  18.         Loop
  19.     Next
  20.     排序值 Range("h2:h857")
  21.     For k = 1 To IIf(D.Count >= 50, 50, D.Count)
  22.         b = Application.Large(D.KEYS, k)
  23.         Set a = Range("h2:h857").Find(What:=b, LookIn:=xlValues)
  24.         If Not a Is Nothing Then aD = a.Address
  25.         Do While Not a Is Nothing
  26.             Range("P100").End(xlUp).Offset(1) = a.Offset(0, -7) '代號
  27.             Range("Q100").End(xlUp).Offset(1) = a.Offset(0, -6) '名稱
  28.             Range("R100").End(xlUp).Offset(1) = a.Offset(0, 0) ' 張
  29.             Range("S100").End(xlUp).Offset(1) = a.Offset(0, -2) '價位
  30.             Set a = Range("h2:h857").FindNext(a)
  31.             If a.Address = aD Then Exit Do
  32.         Loop
  33.     Next
  34. End Sub
  35. '***********
  36. Private Sub 排序值(Rng As Range) '排除有重複的數值
  37.     Dim e As Range
  38.     Set D = CreateObject("SCRIPTING.DICTIONARY")
  39.     For Each e In Rng.SpecialCells(xlCellTypeConstants)
  40.        If IsNumeric(e) Then D(e.Value) = ""
  41.     Next
  42. End Sub
複製代碼
作者: t8899    時間: 2014-10-29 14:50

回復  t8899
Large函數 不是真的傳回數值資料中的第幾大須修改一下
GBKEE 發表於 2014-10-29 13:47


第 6 行，跟第20行 ???  排序值 Range("g2:g857")
作者: GBKEE    時間: 2014-10-29 15:08

回復 5# t8899
   
  1. For K = 1 To 50
  2. b = Application.Large(Range("g2:g857"), K)
  3. If Not IsNumeric(b) Then GoTo 110
複製代碼

Large函數 不是真的傳回數值資料中的第幾大,你是否了解
你的附檔程式碼用 Large函數 , 當 K=13,K=14    b都是=75,
因為 "g2:g857" 有2個75, 另還有2個2,所以都有重複出現.
'*****************************************
排序值 Range("g2:g857")
If IsNumeric(e) Then D(e.Value) = ""  
用字典物件有相同的KEY(相同的數字)來消除重複的數字
b = Application.Large(D.KEYS, k)
如只真正的依序傳回"g2:g857"數值資料中的第k大
作者: t8899    時間: 2014-10-29 20:01

回復  t8899
   
Large函數 不是真的傳回數值資料中的第幾大,你是否了解
你的附檔程式碼用 Large函數  ...
GBKEE 發表於 2014-10-29 15:08



報歉，我的G,H欄是公式 =IF(C2<>E2,"",XQKGIAP|Quote!'1101.TW-BestBidSize1')
套上去出現錯誤，不知如何修改?
#1004#
應用程式物件定義錯誤
作者: luhpro    時間: 2014-10-29 21:03

本帖最後由 luhpro 於 2014-10-29 21:17 編輯
Set a = Range(IIf(c = b, a.Offset(1), Range("g2")), [g857])
此處需要物件??
t8899 發表於 2014-10-29 06:10

底下這一行要放在最前面,
有放了嗎?
Set a = [a1]  ' 因底下 IIF 中  a.Offset(1) 此項會執行計算, 故須先定義 a 的初值,否則會有錯誤.

回復  t8899
Large函數 不是真的傳回數值資料中的第幾大,你是否了解
你的附檔程式碼用 Large函數  ...
GBKEE 發表於 2014-10-29 15:08

以我看樓主的情形並不適合濾掉相同數值的資料,
而是要一一顯示出來的喔.

兩個不同股票的某個值可能相同,
但卻是都需要列出來的,
不能因為某個值相同就只列一支股票的資料,
這支股票不能取代其他股票的資料.

所以我才把 Find 函數的Range範圍設為 : 上次相同值的下一個儲存格開始至最末格止.

報歉，我的G,H欄是公式 =IF(C2<>E2,"",XQKGIAP|Quote!'1101.TW-BestBidSize1')
套上去出現錯誤，不知如何修改?
#1004#
應用程式物件定義錯誤
t8899 發表於 2014-10-29 20:01

經我實際測試過這一行不該發生此錯誤,
不如上傳檔案看看?
作者: GBKEE    時間: 2014-10-30 05:14

本帖最後由 GBKEE 於 2014-10-30 06:55 編輯

回復 8# luhpro
   
以我看樓主的情形並不適合濾掉相同數值的資料,
而是要一一顯示出來的喔.
有一一顯示出啊


[attach]19428[/attach]
  1. Set a = Range("g2:g857").Find(What:=b, LookIn:=xlValues, lookat:=xlWhole)
  2.     If Not a Is Nothing Then aD = a.Address
  3.     Do While Not a Is Nothing
  4.         Range("K100").End(xlUp).Offset(1) = a.Offset(0, -6) '代號
  5.         Range("L100").End(xlUp).Offset(1) = a.Offset(0, -5) '名稱
  6.         Range("M100").End(xlUp).Offset(1) = a.Offset(0, 0) ' 張
  7.         Range("N100").End(xlUp).Offset(1) = a.Offset(0, -4) '價位
  8.         '***************************************************
  9.         Set a = Range("g2:g857").FindNext(a)  '這裡有再往下相同值的儲存格
  10.         If a.Address = aD Then Exit Do  '回到第一個儲存格
  11.         '***********************************************
  12.     Loop
複製代碼
作者: t8899    時間: 2014-10-30 10:31

經我實際測試過這一行不該發生此錯誤,
不如上傳檔案看看?
luhpro 發表於 2014-10-29 21:03


請測驗看看![attach]19429[/attach]
作者: GBKEE    時間: 2014-10-30 12:46

本帖最後由 GBKEE 於 2014-10-30 13:24 編輯

回復 10# t8899
試試看
  1. Private Sub 排序值(Rng As Range) '排除有重複的數值
  2.     Dim e As Range
  3.     Set D = CreateObject("SCRIPTING.DICTIONARY")
  4.     For Each e In Rng.SpecialCells(xlCellTypeFormulas)'特殊儲存格(公式)
  5.        If IsNumeric(e) Then D(e.Value) = ""
  6.     Next
  7. End Sub
複製代碼
下載你的檔案,會詢問是否更新參照,沒有你的DEE應用程式可更新(有DEE公式的儲存格都是錯誤值)
請重新上傳檔案,在ThisWorkbook 模組加上這程式,就不會詢問是否更新參照.
  1. Private Sub Workbook_Open()
  2.     Me.UpdateLinks = xlUpdateLinksNever
  3. End Sub
複製代碼
作者: t8899    時間: 2014-10-30 18:04

回復  t8899
試試看下載你的檔案,會詢問是否更新參照,沒有你的DEE應用程式可更新(有DEE公式的儲存格都是錯 ...
GBKEE 發表於 2014-10-30 12:46


我本來就用在有DDE 的連結啊，因為要提供測試，只把值拷出來
現在都沒問題了啊, 謝謝!



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