返回列表 上一主題 發帖

[發問] 陣列篩選問題(已解決)

[發問] 陣列篩選問題(已解決)

本帖最後由 softsadwind 於 2012-3-16 11:46 編輯

請教各位先進
如業務日報表如下

用公式篩選出不重複的客戶名稱
'=T(INDEX('2011'!B:B,MIN(IF(COUNTIF(B$1:B1,'2011'!$B$2:$B$1536),65536,ROW('2011'!$B$2:$B$1536)))))


再用=OFFSET('2011'!A$1,MATCH(客戶一覽!B2,'2011'!$B:$B,0)-1,0,1,6)
去判別該客戶最後一次聯繫的時間


然後用陣列去判別 n天前 最後一次聯繫
'=IF(最近一次聯繫!$A$2:$A$600<(TODAY()-B1),最近一次聯繫!A2:F600,"")


附件 工作日報表a.rar (11 KB)

因為這樣子做 如果超過2000行之後,只要有一隔資料變更,就會重新計算一次,電腦就一直頓。我只能用儲存值的方式,去減少程式判斷的次數,或者把後面兩個分頁移到另外一各檔案,有需要再打開,才能減少一直判斷的問題。不知道有沒有高手可以指導一下,怎樣用vba來寫。感激不盡。
50 字節以內
不支持自定義 Discuz! 代碼

本帖最後由 GBKEE 於 2011-8-31 13:47 編輯

回復 13# softsadwind
你的語法概念沒有建立
Sheets(2011)     ->在這活頁簿裡的第2011個工作表  2011是數字  
Sheets("2011") -> 個工作表名稱 "2011"是字串
Sheet1.Sheet2.Sheet3.... 是工作表的CodeName -> VBA中工作表的物件名稱

TOP

回復 11# GBKEE

禀告兩位大大....小弟測試如下
用Office 2003主程式開啟
修改名稱
工作表1 :此處需要物件
sheet 1 :型態不符合
sheet1(2011) :物件不支援此屬性或方法

用2010程式開啟
都是出現以下錯誤訊息

系統錯誤&H800700E(-2147024770) 找不到指定的模組
編譯錯誤: With物件的形態必須是使用者自訂型態、Object或Variant之一

所以應該是我安裝的2010有問題...也就是.....(消音)
因為是公司電腦 不容易做任何變更,所以...無限期暫緩...
50 字節以內
不支持自定義 Discuz! 代碼

TOP

回復 10# softsadwind

你的附件中檔案應是2010版存成97-2003版
所以工作表的CodeName是"工作表1"的字串
將程式碼內這些改成正確工作表名稱試試
學海無涯_不恥下問

TOP

回復 10# softsadwind
不是推測應該是2010的語法

With 工作表1
With 工作表2
With 工作表3
修改紅字部分物件名稱符合你的工作表物件名稱例如" Sheet1,Sheet2,Sheet3...

TOP

回復 8# Hsieh

感謝, "謝"大大,我在2003使用此程式碼,出現『沒有物件』,推測應該是2010的語法。所以暫時沒辦法回應這一篇。
50 字節以內
不支持自定義 Discuz! 代碼

TOP

回復 6# GBKEE

感謝版大,這一版就夠用了...
測試起來是ok的...
如不介意 我會把這個範例放在個人臉書上
畢竟問來的 比較容易忘記
得找個地方標記起來:>
50 字節以內
不支持自定義 Discuz! 代碼

TOP

回復 7# softsadwind
照著你的公式意義,改成使用VBA敘述
  1. Sub ex()
  2. Dim Ar()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")
  5. With 工作表1
  6.    For Each a In .Range(.[B2], .[B65536].End(xlUp))
  7.       d(a.Value) = a.Offset(, -1).Value
  8.       d1(a.Value) = a.Offset(, -1).Resize(, 6).Value
  9.    Next
  10. End With
  11. With 工作表2
  12. .[B2:B65536] = ""
  13. .[B2].Resize(d.Count, 1) = Application.Transpose(d.keys)
  14. End With
  15. With 工作表3
  16. .[A2:F65536] = ""
  17. .[A2].Resize(d1.Count, 6) = Application.Transpose(Application.Transpose(d1.items))
  18. End With
  19. With 工作表4
  20. n = .[B1]
  21. For Each ky In d.keys
  22. If Date - n >= d(ky) Then
  23. ReDim Preserve Ar(s)
  24. Ar(s) = d1(ky)
  25. s = s + 1
  26. End If
  27. Next
  28. .[A3:F65536] = ""
  29. .[A3].Resize(s, 6) = Application.Transpose(Application.Transpose(Ar))
  30. End With
  31. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 6# GBKEE


    謝謝 我回公司再來測試,測試後再回饋
50 字節以內
不支持自定義 Discuz! 代碼

TOP

回復 5# softsadwind
然後再用複製的方式 接續2011頁面的最後一行,2011那一頁就維持原貌。  請你來完成
  1. Sub Ex()
  2.     Dim D As Object, Rng As Range, E As Variant
  3.     Set D = CreateObject("SCRIPTING.DICTIONARY")
  4.     Set Rng = Sheets("2011").[A2]
  5.     Do While Rng <> ""
  6.         If D.exists(Rng.Cells(1, 2).Value) = 0 Then
  7.             Set D(Rng.Cells(1, 2).Value) = Rng.Resize(, 6)
  8.         Else
  9.         If D(Rng.Cells(1, 2).Value).Cells(1) < Rng Then Set D(Rng.Cells(1, 2).Value) = Rng.Resize(, 6)
  10.         End If
  11.         Set Rng = Rng.Offset(1)
  12.     Loop
  13.     Sheets("最近一次聯繫").UsedRange.Offset(1).Clear
  14.     Sheets("Last - N").UsedRange.Offset(2).Clear
  15.     For Each E In D.Items
  16.         If Date >= DateAdd("M", 1, E.Cells(1)) Then E.Copy Sheets("Last - N").Range("A" & Rows.Count).End(xlUp).Offset(1)
  17.         E.Copy Sheets("最近一次聯繫").Range("A" & Rows.Count).End(xlUp).Offset(1)
  18.     Next
  19.     Set D = Nothing
  20.     Set Rng = Nothing
  21. End Sub
複製代碼

TOP

        靜思自在 : 改變自己是自救,影響別人是救人。
返回列表 上一主題