Board logo

標題: [發問] 陣列篩選問題(已解決) [打印本頁]
作者: softsadwind    時間: 2011-8-25 12:05     標題: 陣列篩選問題(已解決)

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

請教各位先進
如業務日報表如下
[attach]7574[/attach]
用公式篩選出不重複的客戶名稱
'=T(INDEX('2011'!B:B,MIN(IF(COUNTIF(B$1:B1,'2011'!$B$2:$B$1536),65536,ROW('2011'!$B$2:$B$1536)))))
[attach]7577[/attach]

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

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

附件[attach]7576[/attach]

因為這樣子做 如果超過2000行之後，只要有一隔資料變更，就會重新計算一次，電腦就一直頓。我只能用儲存值的方式，去減少程式判斷的次數，或者把後面兩個分頁移到另外一各檔案，有需要再打開，才能減少一直判斷的問題。不知道有沒有高手可以指導一下，怎樣用vba來寫。感激不盡。
作者: oobird    時間: 2011-8-25 12:50

判別 n天前 最後一次聯繫

最終目的是要得到什麼樣的結果？
作者: softsadwind    時間: 2011-8-25 13:31

回復 2# oobird
這是開發用的日報表
間隔N天（一般是30天)再聯繫一次，是為了避免過度密集的丟信，被當成垃圾信。
所以這個篩選是一直持續的
每N天就會出現客戶名稱，方便業務人員去過濾名單和寄出廣告信件。

我想用個例子來看，可能會更清楚

A客戶 8/25聯繫過，因為是開發中..所以不見得會有回應...因此他的最後一次聯繫的日子還是在8/25
到9/25那天，判別N天(N=30) ，A客戶就會在出現一次。 業務根據這個名單，再寄發一次廣告信。這時候，就會把最後一次聯繫的日期改成9/25，手動匯入日報表內。

所以A客戶在日報表會有兩欄
9/25  a客戶
8/25 a客戶

等到10/25，又會被篩選出現一次，再手動更新a客戶的聯繫日期為10/25
日報表就變成
10/25 a客戶 .......
9/25 a客戶.....
8/25 a客戶......

如果不用N 那就是直接用30帶進去，以30天為一個循環。
作者: GBKEE    時間: 2011-8-25 15:47

回復 3# softsadwind
  1. Option Explicit
  2. Sub Ex()
  3.     Dim i As Double
  4.     With Sheets("2011")
  5.         .AutoFilterMode = False
  6.         For i = .Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
  7.             If Date = DateAdd("M", 1, .Cells(i, "A")) Then  '間隔1個月
  8.                 With .Cells(i, "A").Resize(, 6)
  9.                     .Copy
  10.                     .Insert xlShiftDown
  11.                     .Cells(0, 1) = Date
  12.                     .Cells(0, 5) = ""
  13.                 End With
  14.             End If
  15.         Next
  16.         .Range("A1").AutoFilter 5, "="
  17.     End With
  18. End Sub
複製代碼
作者: softsadwind    時間: 2011-8-26 12:05

本帖最後由 softsadwind 於 2011-8-26 13:24 編輯

感謝，不過這程式跑出來是會直接幫你把剛好滿一個月的列出來..
並直接幫你把資料以今天的名義新增上去，並單獨顯示出來。這樣子是方便直接用該頁寄發信件。

不過會發生一個問題，就是遇到六日沒上班，這兩天的資料 就會跳過 讓過..
篩選條件要變成30日之前的都要列出來，把這些計算結果複製到新分頁，
然後再用複製的方式 接續2011頁面的最後一行
2011那一頁就維持原貌。
作者: GBKEE    時間: 2011-8-27 16:53

回復 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
複製代碼
作者: softsadwind    時間: 2011-8-27 19:33

回復 6# GBKEE


    謝謝 我回公司再來測試，測試後再回饋
作者: Hsieh    時間: 2011-8-28 10:07

回復 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
複製代碼
作者: softsadwind    時間: 2011-8-29 13:07

回復 6# GBKEE

感謝版大，這一版就夠用了...
測試起來是ok的...
如不介意 我會把這個範例放在個人臉書上
畢竟問來的 比較容易忘記
得找個地方標記起來:>
作者: softsadwind    時間: 2011-8-29 13:32

回復 8# Hsieh

感謝， "謝"大大，我在2003使用此程式碼，出現『沒有物件』，推測應該是2010的語法。所以暫時沒辦法回應這一篇。
作者: GBKEE    時間: 2011-8-29 14:18

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

With 工作表1
With 工作表2
With 工作表3
修改紅字部分物件名稱符合你的工作表物件名稱例如" Sheet1,Sheet2,Sheet3...
作者: Hsieh    時間: 2011-8-29 17:59

回復 10# softsadwind

你的附件中檔案應是2010版存成97-2003版
所以工作表的CodeName是"工作表1"的字串
將程式碼內這些改成正確工作表名稱試試
作者: softsadwind    時間: 2011-8-30 16:25

回復 11# GBKEE

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

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

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

所以應該是我安裝的2010有問題...也就是.....(消音)
因為是公司電腦 不容易做任何變更，所以...無限期暫緩...
作者: GBKEE    時間: 2011-8-31 13:07

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

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



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