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

softsadwind

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

下載 (65.33 KB)

2011-8-25 11:57

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

下載 (58.52 KB)

2011-8-25 11:57

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

下載 (39.64 KB)

2011-8-25 11:57

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

下載 (46.66 KB)

2011-8-25 11:57

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

下載次數: 17

2011-8-25 11:57

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

oobird

判別 n天前 最後一次聯繫

最終目的是要得到什麼樣的結果？

softsadwind

回復 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

回復 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

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

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

GBKEE

回復 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

回復 6# GBKEE


    謝謝 我回公司再來測試，測試後再回饋

Hsieh

回復 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

回復 6# GBKEE

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

softsadwind

回復 8# Hsieh

感謝， "謝"大大，我在2003使用此程式碼，出現『沒有物件』，推測應該是2010的語法。所以暫時沒辦法回應這一篇。