luhpro

回復 3# adam2010
使用儲存格公式的方式我想不出來,
在此提供一個 Excel VBA 程式完成的方式:

1. Sub nn()
   
2.   Dim iI%
   
3.   Dim lRow&
   
4.   Dim sItem$
   
5.   Dim bNFind As Boolean
   
6.   Dim dDate As Date
   
7.   Dim vA(), vD
   
8.   
   
9.   ReDim vA(0 To 2, 0)
   
10.   Set vD = CreateObject("Scripting.Dictionary")
    
11.   
    
12.   lRow = 2
    
13.   With Sheets("總表")
    
14.     Do While .Cells(lRow, 1) <> ""
    
15.       With .Cells(lRow, 1)
    
16.         sItem = .Text
    
17.         dDate = .Offset(, 2)
    
18.         If Not vD.exists(sItem) Then
    
19.           ReDim Preserve vA(0 To 2, UBound(vA, 2) + 1)
    
20.           vA(0, UBound(vA, 2)) = dDate
    
21.           vD(sItem) = UBound(vA, 2)
    
22.         Else
    
23.           bNFind = True
    
24.           For iI = 0 To 2
    
25.             If dDate = vA(iI, vD(sItem)) Then bNFind = False
    
26.           Next
    
27.           If bNFind Then
    
28.             If vA(1, vD(sItem)) = "" Then
    
29.               vA(1, vD(sItem)) = dDate
    
30.               vA(2, vD(sItem)) = #12/31/9999#
    
31.             Else
    
32.               If dDate > vA(1, vD(sItem)) Then
    
33.                 If dDate < vA(2, vD(sItem)) Then vA(2, vD(sItem)) = dDate
    
34.               Else
    
35.                 If dDate < vA(0, vD(sItem)) Then
    
36.                   vA(0, vD(sItem)) = dDate
    
37.                   vA(1, vD(sItem)) = vA(0, vD(sItem))
    
38.                   vA(2, vD(sItem)) = vA(1, vD(sItem))
    
39.                 Else
    
40.                   vA(1, vD(sItem)) = dDate
    
41.                   vA(2, vD(sItem)) = vA(1, vD(sItem))
    
42.                 End If
    
43.               End If
    
44.             End If
    
45.           End If
    
46.         End If
    
47.       End With
    
48.       lRow = lRow + 1
    
49.     Loop
    
50.   End With
    
51.   
    
52.   lRow = 2
    
53.   With Sheets("追蹤")
    
54.     Do While .Cells(lRow, 1) <> ""
    
55.       With .Cells(lRow, 1)
    
56.         If vD.exists(.Text) Then
    
57.           For iI = 0 To 2
    
58.             .Offset(, iI + 1) = vA(iI, vD(.Text))
    
59.           Next
    
60.         End If
    
61.       End With
    
62.       lRow = lRow + 1
    
63.     Loop
    
64.   End With
    
65. End Sub

複製代碼