Hsieh

¦^´_ 2# maiko

1. Sub Search_Data()
   
2. d = [A2]
   
3. [A2] = IIf([A2] >= 1 And [A2] <= 12, "=MONTH(Sheet2!A2)=" & d, IIf(d = "", "", "=YEAR(Sheet2!A2)=" & d))
   
4. [A1] = IIf([A2] <> "", "", "¤é´Á")
   
5. With Sheet2
   
6. .Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheet1.[A1:C2], Sheet1.[A6:D6], False
   
7. End With
   
8. Cells(Rows.Count, 3).End(xlUp).Offset(2).Resize(, 2) = Array("Á`¦@:", "=SUM(R7C:R[-1]C)")
   
9. [A2] = d
   
10. [A1] = "¤é´Á"
    
11. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 5# maiko
¶i¶¥¬d¸ß¡A¦b¤@¯ë¼Ò²Õ

1. Sub Search_Data()
   
2. With Sheet1
   
3.   y = .[A2]: m = .[B2]: d = .[C2]
   
4.   .[A2] = IIf(.[A2] = "", "", "=YEAR(Sheet2!A2)=" & y)
   
5.   .[B2] = IIf(.[B2] = "", "", "=MONTH(Sheet2!A2)=" & m)
   
6.   .[C2] = IIf(.[C2] = "", "", "=DAY(Sheet2!A2)=" & d)
   
7. With Sheet2
   
8.    .Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheet1.[A1:E2], Sheet1.[A6:D6], False
   
9. End With
   
10. If .[A7] = "" Then
    
11.   MsgBox "µL¸ê®Æ"
    
12. Else
    
13.   .Cells(.Rows.Count, 3).End(xlUp).Offset(2).Resize(, 2) = Array("Á`¦@:", "=SUM(R7C:R[-1]C)")
    
14. End If
    
15.   .[A2] = y
    
16.   .[B2] = m
    
17.   .[C2] = d
    
18. End With
    
19. End Sub

½Æ»s¥N½X

¨ú±oSheet2¤u§@ªíB¡BCÄ椣­«½Æ²M³æ°µ¬°ÅçÃÒ²M³æ
Sheet2¤u§@ªí¼Ò²Õ

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. If Target.Column = 2 Or Target.Column = 3 Then
   
5. For Each a In Range([B2], Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeConstants)
   
6. d(a.Value) = ""
   
7. d1(a.Offset(, 1).Value) = ""
   
8. Next
   
9. With Sheet1
   
10.   With .Range("D2").Validation
    
11.   .Delete
    
12.   .Add xlValidateList, , , Join(d.keys, ",")
    
13.   End With
    
14.   With .Range("E2").Validation
    
15.   .Delete
    
16.   .Add xlValidateList, , , Join(d1.keys, ",")
    
17.   End With
    
18. End With
    
19. End If
    
20. End Sub

½Æ»s¥N½X

Sheet2¤u§@ªíB¡BCÄ榳ÅܰʮɡASheet1¤u§@ªí[D2]¡B[E2]ªºÅçÃÒ²M³æ´N·|§ïÅÜ

Hsieh

¦^´_ 8# maiko


    §A§â¥N½X©ñ¿ù¤u§@ªí¼Ò²Õ
­n©ñ¦bSheet2¤u§@ªí¼Ò²Õ¤º
µM«áÅÜ°ÊB¡BCÄæ¸ê®Æ
¥u¦³D2¡BE2¦³ÅçÃÒ¡A¬O¦]¬°¶i¶¥¿z¿ï·Ç«h½d³ò¥Ø«e¥u¦³A1:E2
¨ä¥L³¡¤À¨Ã¤£»Ý­nÅçÃÒ²M³æ¡A­Y§A¦³»Ý¨D¥u­n§â½d³ò§ï¤@¤U´N¦n

Hsieh

¦^´_ 11# maiko

¦bSheet2¤¤ªºB¡BCÄæÀH«K¥´­Ó¸ê®Æ¬Ý¬Ý

Hsieh

¦^´_ 14# maiko

Book3_New.rar (26.71 KB)

¤U¸ü¦¸¼Æ: 18

2012-9-26 20:39

sheet1¼Ò²Õ

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Application.EnableEvents = False
   
3. If Not Intersect(Target, [A2:C2]) Is Nothing Then CreateList
   
4. Application.EnableEvents = True
   
5. End Sub

½Æ»s¥N½X

¤@¯ë¼Ò²Õ

1. Sub Search_Data_New()
   
2. Application.ScreenUpdating = False
   
3. Application.EnableEvents = False
   
4. With Sheet1
   
5.   y = .[A2]: m = .[B2]: d = .[C2]
   
6.   .[A2] = IIf(.[A2] = "", "", "=YEAR(Sheet2!A2)=" & y)
   
7.   .[B2] = IIf(.[B2] = "", "", "=MONTH(Sheet2!A2)=" & m)
   
8.   .[C2] = IIf(.[C2] = "", "", "=DAY(Sheet2!A2)=" & d)
   
9. 
   
10. With Sheet2
    
11.    .Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheet1.[A1:E2], Sheet1.[A6:D6], False
    
12. End With
    
13. 
    
14. If .[A7] = "" Then
    
15.   MsgBox "µL¸ê®Æ"
    
16. Else
    
17.   .Cells(.Rows.Count, 3).End(xlUp).Offset(2).Resize(, 2) = Array("Á`¦@:", "=SUM(R7C:R[-1]C)")
    
18. End If
    
19.   
    
20.   .[A2] = y
    
21.   .[B2] = m
    
22.   .[C2] = d
    
23. 
    
24. End With
    
25. Application.ScreenUpdating = True
    
26. Application.EnableEvents = True
    
27. End Sub
    
28. Sub CreateList()
    
29. Dim A As Range
    
30. Set dic = CreateObject("Scripting.Dictionary")
    
31. Set dic1 = CreateObject("Scripting.Dictionary")
    
32. With Sheet1
    
33.   y = .[A2]: m = .[B2]: d = .[C2]
    
34.   .[A2] = IIf(.[A2] = "", "", "=YEAR(Sheet2!A2)=" & y)
    
35.   .[B2] = IIf(.[B2] = "", "", "=MONTH(Sheet2!A2)=" & m)
    
36.   .[C2] = IIf(.[C2] = "", "", "=DAY(Sheet2!A2)=" & d)
    
37. 
    
38. With Sheet2
    
39. .[F1:G1] = .[B1:C1].Value
    
40.    .Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheet1.[A1:C2], .[F1:G1], True
    
41.    r = .Range("F1").CurrentRegion.Rows.Count
    
42.    With .Range(.[F1], .[F1].End(xlDown))
    
43.    .Sort key1:=.Cells(1, 1), Header:=xlYes
    
44.    If r > 1 Then
    
45.    For Each A In .Cells(1).Offset(1).Resize(.Count - 1, 1)
    
46.       dic(A.Value) = ""
    
47.    Next
    
48.    End If
    
49.    .Clear
    
50.    End With
    
51.    With .Range(.[G1], .[G1].End(xlDown))
    
52.    .Sort key1:=.Cells(1, 1), Header:=xlYes
    
53.    If r > 1 Then
    
54.    For Each A In .Cells(1).Offset(1).Resize(.Count - 1, 1)
    
55.       dic1(A.Value) = ""
    
56.    Next
    
57.    End If
    
58.    .Clear
    
59.    End With
    
60. 
    
61. End With
    
62. With .Range("D2").Validation
    
63.   .Delete
    
64.   If r > 1 Then .Add xlValidateList, , , Join(dic.keys, ",")
    
65. End With
    
66. With .Range("E2").Validation
    
67.   .Delete
    
68.   If r > 1 Then .Add xlValidateList, , , Join(dic1.keys, ",")
    
69. End With
    
70.   
    
71.   .[A2] = y
    
72.   .[B2] = m
    
73.   .[C2] = d
    
74. 
    
75. End With
    
76. End Sub

½Æ»s¥N½X