c_c_lai

¦^´_ 50# starbox520
¦A³Â·Ð¥J²Ó®Õ¹ï¬O§_¬° "²Ä¤@ºØ" ¿ï¶µ¤§¥¿½Tµª®×¡G
a.rar (2.79 KB)

¤U¸ü¦¸¼Æ: 4

2016-12-2 08:51

½T©w«á¡A©l¯à¶i¦æ¤U¤@¨BÆJªº¼¶¼g¨Æ©y¡C

c_c_lai

¦^´_ 50# starbox520

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.    
   
3.     If IsError(Target(1)) Then Unload frmSelector:         Exit Sub
   
4.      
   
5.     '  If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 5 Then
   
6.     If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 6 Then
   
7.         Set Sh_Rng = Cells(Target(1).Row, "F")
   
8. 
   
9.         AuditCustPkg (Cells(Target(1).Row, "F"))
   
10. 
    
11.         If IsEmpty(Sh_Ar) Then MsgBox Sh_Rng & "-" & Sh_Rng(1, 2) & vbLf & "§ä¤£¨ì": Exit Sub
    
12.         Unload frmSelector
    
13.         frmSelector.Show False
    
14.     Else
    
15.         Unload frmSelector
    
16.     End If
    
17. End Sub

½Æ»s¥N½X

c_c_lai

1. Private Sub CustPkg(Ar3 As Variant)
   
2.     Dim c As Variant, Ar As Variant, cts As Integer, tf As Boolean
   
3.     Dim i As Integer, ii As Integer, frstAddr As String
   
4.    
   
5.     Sh_Ar = Ar
   
6.    
   
7.     With Sheets("¤u§@ªí2")
   
8.         For cts = LBound(Ar3) To UBound(Ar3)
   
9.             Set c = .[A:A].Find(Ar3(cts)(0), , , 1)       '  "TR±Æ¾÷&²£¥X" Customer ¤ñ¹ï "Cus²½X"
   
10.             '  Set c = .[A:A].Find(Ar3(1)(0), , , 1)      '  "TR±Æ¾÷&²£¥X" Customer ¤ñ¹ï "Cus²½X"
    
11.         
    
12.             If Not c Is Nothing Then
    
13.                 frstAddr = c.Address
    
14.                 Do
    
15.                     If c.Offset(, 1) = Ar3(cts)(1) And c.Offset(, 2) = Ar3(cts)(2) Then
    
16.                     '  If c.Offset(, 1) = Ar3(1)(1) And c.Offset(, 2) = Ar3(1)(2) Then
    
17.                        tf = True
    
18.                        If IsEmpty(Ar) Then
    
19.                             ReDim Ar(1 To 8, 1 To 1)
    
20.                         Else
    
21.                             For i = 1 To UBound(Ar, 2)
    
22.                                 If Ar(1, i) = c.Offset(, 1).Text And Ar(2, i) = c.Offset(, 2).Text And Ar(3, i) = c.Offset(, 3).Text And Ar(4, i) = c.Offset(, 4).Text Then tf = False
    
23.                             Next i
    
24.                             If tf Then ReDim Preserve Ar(1 To 8, 1 To UBound(Ar, 2) + 1)
    
25.                         End If
    
26.                         If tf Then
    
27.                             For ii = 1 To 8
    
28.                                 Ar(ii, UBound(Ar, 2)) = c.Offset(, ii).Text
    
29.                             Next
    
30.                         End If
    
31.                     End If
    
32.                
    
33.                     Set c = .[A:A].FindNext(c)
    
34.                 Loop While Not c Is Nothing And c.Address <> frstAddr
    
35.             End If
    
36.         Next cts        
    
37.     End With
    
38.    
    
39.     If IsEmpty(Ar) Then Exit Sub
    
40.     Sh_Ar = Application.Transpose(Ar)
    
41. End Sub

½Æ»s¥N½X

c_c_lai

1. Sub AuditCustPkg(Adt_Rng As Range)
   
2.     Dim c As Range, frstAddr As String, tf As Boolean
   
3.     Dim cts As Integer, ct2 As Integer
   
4.     Dim Arr As Variant, Ar2 As Variant, Ar3 As Variant
   
5.    
   
6.     With Sheets("Cus²½X")
   
7.         Set c = .[B:B].Find(Adt_Rng.Offset(, -1).Value, , , 1)  ' "TR±Æ¾÷&²£¥X" Customer ¤ñ¹ï "Cus²½X" CUST_GROUP
   
8.         
   
9.         If Not c Is Nothing Then
   
10.             frstAddr = c.Address
    
11.             Do
    
12.                 If IsEmpty(Arr) Then ReDim Arr(1 To 1) Else ReDim Preserve Arr(1 To UBound(Arr) + 1)
    
13.                 Arr(UBound(Arr)) = Array(c.Offset(, -1).Text, c.Text)
    
14.                
    
15.                 Set c = .[B:B].FindNext(c)
    
16.             Loop While Not c Is Nothing And c.Address <> frstAddr
    
17.         End If
    
18.     End With
    
19.    
    
20.     If Not IsEmpty(Arr) Then
    
21.         With Sheets("§÷®Æ")
    
22.             For cts = LBound(Arr) To UBound(Arr)
    
23.                 Set c = .[M:M].Find(Arr(cts)(0), , , 1)      '  "Cus²½X" CODE ¤ñ¹ï "§÷®Æ" CUST_CODE
    
24.                
    
25.                 If Not c Is Nothing Then      '  Arr(cts)(0) = "ASM" : Variant/String
    
26.                     frstAddr = c.Address
    
27.                     Do
    
28.                         '  ¥H "TR±Æ¾÷&²£¥X" ªº  "F"¡B"G"¡B"H" ¬°±ø¥ó¡A¥h "§÷®Æ" §ä¨ì¹ïÀ³ªº¼Æ¾Ú¡C
    
29.                         '  ²Ä 1 ºØ (¬Û¦P Cust (c.Value) & PKG (c.Offset(, 3))  & B/S (c.Offset(, 4)) & L/C (c.Offset(, 5)))
    
30.                         If c.Offset(, 3) = Adt_Rng.Value And c.Offset(, 4) = Adt_Rng.Offset(, 1).Value And c.Offset(, 5) = CStr(Adt_Rng.Offset(, 2).Value) Then
    
31.                             If IsEmpty(Ar2) Then ReDim Ar2(1 To 1) Else ReDim Preserve Ar2(1 To UBound(Ar2) + 1)
    
32.                             Ar2(UBound(Ar2)) = Array(c.Text, Arr(cts)(1), c.Offset(, 3).Text, c.Offset(, 4).Text, c.Offset(, 5).Text, c.Offset(, 39).Text, c.Offset(, 40).Text)
    
33.                         End If
    
34.                         
    
35.                         Set c = .[M:M].FindNext(c)
    
36.                     Loop While Not c Is Nothing And c.Address <> frstAddr
    
37.                 End If
    
38.                
    
39.                 If Not IsEmpty(Ar2) Then
    
40.                     For ct2 = LBound(Ar2) To UBound(Ar2)
    
41.                         '  ¥H ¤u§@ªí "TR±Æ¾÷&²£¥X" ªº  "F"¡B"G"¡B"H" ¬°±ø¥ó¡A ¥h ¤u§@ªí "§÷®Æ" §ä¨ì¹ïÀ³ªº¼Æ¾Ú¡F
    
42.                         '  µM«á§ä¨ì³oµ§¼Æ¾Úªº "CARRIER1 P/N"¡AµM«á¥u­n¤@¼Ë "CARRIER1 P/N" ªº³£¦C¥X¨Ó¡C
    
43.                         Set c = .[BA:BA].Find(Ar2(ct2)(6), , , 1)   '  CARRIER1 P/N ("BA")  Ar2(ct2)(6) = "4100998111" : Variant/String
    
44.                         
    
45.                         If Not c Is Nothing Then   ' PKG (c.Offset(, -37)) ¡B BODU_SIZE (c.Offset(, -36))
    
46.                             frstAddr = c.Address   ' CUST_CODE (c.Offset(, -40).Text)¡B, LEAD_COUNT (c.Offset(, -35).Text)
    
47.                             Do  '  "BA" Äæ¦ì«üªº¬OÄx¤l¡A¥u­n¬O¦b¦P­ÓÄx¤l¤ºªº´N¥i¥H¡A­nªº´N¬O·Qª¾¹D¥Î³o­ÓÄx¤lªº¦³­þ¨Ç¤H¡C
    
48.                                 '  ¦P¨B¦a±Æ°£­ì¥ý¦b ¤u§@ªí "TR±Æ¾÷&²£¥X" ÂI¿ïªº Package¡C(Customer¡BPackage¡BBodysize)
    
49.                                 '  ­×¥¿¥H "Cus²½X" Arr ¤§²Ä¤@²Õ (Arr(1)(0)) §@¬°§PÂ_¨Ì¾Ú¡C
    
50.                                 tf = (c.Offset(, -40).Text = Arr(1)(0) And c.Offset(, -37) = Adt_Rng.Value And c.Offset(, -36) = Adt_Rng.Offset(, 1).Value)
    
51.                                 If Ar2(ct2)(1) <> "" And tf = False Then
    
52.                                     If IsEmpty(Ar3) Then ReDim Ar3(1 To 1) Else ReDim Preserve Ar3(1 To UBound(Ar3) + 1)
    
53.                                     Ar3(UBound(Ar3)) = Array(Ar2(ct2)(1), c.Offset(, -37).Text, c.Offset(, -36).Text, c.Offset(, -35).Text, c.Text)
    
54.                                 End If
    
55. 
    
56.                                 Set c = .[BA:BA].FindNext(c)
    
57.                             Loop While Not c Is Nothing And c.Address <> frstAddr
    
58.                         End If
    
59.                     Next ct2
    
60.                 End If
    
61.             Next cts
    
62.         End With
    
63.         
    
64.         If Not IsEmpty(Ar3) Then CustPkg (Ar3)
    
65.     End If
    
66.    
    
67. Sub AuditCustPkg(Adt_Rng As Range)
    
68.     Dim c As Range, frstAddr As String, tf As Boolean
    
69.     Dim cts As Integer, ct2 As Integer
    
70.     Dim Arr As Variant, Ar2 As Variant, Ar3 As Variant
    
71.    
    
72.     With Sheets("Cus²½X")
    
73.         Set c = .[B:B].Find(Adt_Rng.Offset(, -1).Value, , , 1)  ' "TR±Æ¾÷&²£¥X" Customer ¤ñ¹ï "Cus²½X" CUST_GROUP
    
74.         
    
75.         If Not c Is Nothing Then
    
76.             frstAddr = c.Address
    
77.             Do
    
78.                 If IsEmpty(Arr) Then ReDim Arr(1 To 1) Else ReDim Preserve Arr(1 To UBound(Arr) + 1)
    
79.                 Arr(UBound(Arr)) = Array(c.Offset(, -1).Text, c.Text)
    
80.                
    
81.                 Set c = .[B:B].FindNext(c)
    
82.             Loop While Not c Is Nothing And c.Address <> frstAddr
    
83.         End If
    
84.     End With
    
85.    
    
86.     If Not IsEmpty(Arr) Then
    
87.         With Sheets("§÷®Æ")
    
88.             For cts = LBound(Arr) To UBound(Arr)
    
89.                 Set c = .[M:M].Find(Arr(cts)(0), , , 1)      '  "Cus²½X" CODE ¤ñ¹ï "§÷®Æ" CUST_CODE
    
90.                
    
91.                 If Not c Is Nothing Then      '  Arr(cts)(0) = "ASM" : Variant/String
    
92.                     frstAddr = c.Address
    
93.                     Do
    
94.                         '  ¥H "TR±Æ¾÷&²£¥X" ªº  "F"¡B"G"¡B"H" ¬°±ø¥ó¡A¥h "§÷®Æ" §ä¨ì¹ïÀ³ªº¼Æ¾Ú¡C
    
95.                         '  ²Ä 1 ºØ (¬Û¦P Cust (c.Value) & PKG (c.Offset(, 3))  & B/S (c.Offset(, 4)) & L/C (c.Offset(, 5)))
    
96.                         If c.Offset(, 3) = Adt_Rng.Value And c.Offset(, 4) = Adt_Rng.Offset(, 1).Value And c.Offset(, 5) = CStr(Adt_Rng.Offset(, 2).Value) Then
    
97.                             If IsEmpty(Ar2) Then ReDim Ar2(1 To 1) Else ReDim Preserve Ar2(1 To UBound(Ar2) + 1)
    
98.                             Ar2(UBound(Ar2)) = Array(c.Text, Arr(cts)(1), c.Offset(, 3).Text, c.Offset(, 4).Text, c.Offset(, 5).Text, c.Offset(, 39).Text, c.Offset(, 40).Text)
    
99.                         End If
    
100.                         
     
101.                         Set c = .[M:M].FindNext(c)
     
102.                     Loop While Not c Is Nothing And c.Address <> frstAddr
     
103.                 End If
     
104.                
     
105.                 If Not IsEmpty(Ar2) Then
     
106.                     For ct2 = LBound(Ar2) To UBound(Ar2)
     
107.                         '  ¥H ¤u§@ªí "TR±Æ¾÷&²£¥X" ªº  "F"¡B"G"¡B"H" ¬°±ø¥ó¡A ¥h ¤u§@ªí "§÷®Æ" §ä¨ì¹ïÀ³ªº¼Æ¾Ú¡F
     
108.                         '  µM«á§ä¨ì³oµ§¼Æ¾Úªº "CARRIER1 P/N"¡AµM«á¥u­n¤@¼Ë "CARRIER1 P/N" ªº³£¦C¥X¨Ó¡C
     
109.                         Set c = .[BA:BA].Find(Ar2(ct2)(6), , , 1)   '  CARRIER1 P/N ("BA")  Ar2(ct2)(6) = "4100998111" : Variant/String
     
110.                         
     
111.                         If Not c Is Nothing Then   ' PKG (c.Offset(, -37)) ¡B BODU_SIZE (c.Offset(, -36))
     
112.                             frstAddr = c.Address   ' CUST_CODE (c.Offset(, -40).Text)¡B, LEAD_COUNT (c.Offset(, -35).Text)
     
113.                             Do  '  "BA" Äæ¦ì«üªº¬OÄx¤l¡A¥u­n¬O¦b¦P­ÓÄx¤l¤ºªº´N¥i¥H¡A­nªº´N¬O·Qª¾¹D¥Î³o­ÓÄx¤lªº¦³­þ¨Ç¤H¡C
     
114.                                 '  ¦P¨B¦a±Æ°£­ì¥ý¦b ¤u§@ªí "TR±Æ¾÷&²£¥X" ÂI¿ïªº Package¡C(Customer¡BPackage¡BBodysize)
     
115.                                 '  ­×¥¿¥H "Cus²½X" Arr ¤§²Ä¤@²Õ (Arr(1)(0)) §@¬°§PÂ_¨Ì¾Ú¡C
     
116.                                 tf = (c.Offset(, -40).Text = Arr(1)(0) And c.Offset(, -37) = Adt_Rng.Value And c.Offset(, -36) = Adt_Rng.Offset(, 1).Value)
     
117.                                 If Ar2(ct2)(1) <> "" And tf = False Then
     
118.                                     If IsEmpty(Ar3) Then ReDim Ar3(1 To 1) Else ReDim Preserve Ar3(1 To UBound(Ar3) + 1)
     
119.                                     Ar3(UBound(Ar3)) = Array(Ar2(ct2)(1), c.Offset(, -37).Text, c.Offset(, -36).Text, c.Offset(, -35).Text, c.Text)
     
120.                                 End If
     
121. 
     
122.                                 Set c = .[BA:BA].FindNext(c)
     
123.                             Loop While Not c Is Nothing And c.Address <> frstAddr
     
124.                         End If
     
125.                     Next ct2
     
126.                 End If
     
127.             Next cts
     
128.         End With
     
129.         
     
130.         If Not IsEmpty(Ar3) Then CustPkg (Ar3)
     
131.     End If
     
132.    
     
133.     Set Arr = Nothing
     
134.     Set Ar2 = Nothing
     
135.     Set Ar3 = Nothing
     
136. End Sub

½Æ»s¥N½X

starbox520

¦^´_ 54# c_c_lai


    ¨S¿ù!!!!
    ²Ä¤@ºØ¿zªkµ²ªG¬O¹ïªº!!!!¤Ó¼F®`¤FC¤j!!!!

c_c_lai

¦^´_ 55# starbox520
©p±N§Ú¥Ø«e­×¥¿ªºµ{¦¡½X®M¤J§Aªºµ{¦¡¤¤¡A
¶]¤@¦¸¬Ý¬Ýµ²ªG¬O§_¦p§A©ÒÄ@¡H

starbox520

¦^´_ 56# c_c_lai


   

¤U¸ü (37.15 KB)

2016-12-2 13:47

     ¨º£°¦w®º...

1. Sub AuditCustPkg(Adt_Rng As Range)
   
2.     Dim c As Range, frstAddr As String, tf As Boolean
   
3.     Dim cts As Integer, ct2 As Integer
   
4.     Dim Arr As Variant, Ar2 As Variant, Ar3 As Variant
   
5.    
   
6.     With Sheets("Cus²½X")
   
7.         Set c = .[B:B].Find(Adt_Rng.Offset(, -1).Value, , , 1)  ' "TR±Æ¾÷&²£¥X" Customer ¤ñ¹ï "Cus²½X" CUST_GROUP
   
8.         
   
9.         If Not c Is Nothing Then
   
10.             frstAddr = c.Address
    
11.             Do
    
12.                 If IsEmpty(Arr) Then ReDim Arr(1 To 1) Else ReDim Preserve Arr(1 To UBound(Arr) + 1)
    
13.                 Arr(UBound(Arr)) = Array(c.Offset(, -1).Text, c.Text)
    
14.                
    
15.                 Set c = .[B:B].FindNext(c)
    
16.             Loop While Not c Is Nothing And c.Address <> frstAddr
    
17.         End If
    
18.     End With
    
19.    
    
20.     If Not IsEmpty(Arr) Then
    
21.         With Sheets("§÷®Æ")
    
22.             For cts = LBound(Arr) To UBound(Arr)
    
23.                 Set c = .[M:M].Find(Arr(cts)(0), , , 1)      '  "Cus²½X" CODE ¤ñ¹ï "§÷®Æ" CUST_CODE
    
24.                
    
25.                 If Not c Is Nothing Then      '  Arr(cts)(0) = "ASM" : Variant/String
    
26.                     frstAddr = c.Address
    
27.                     Do
    
28.                         '  ¥H "TR±Æ¾÷&²£¥X" ªº  "F"¡B"G"¡B"H" ¬°±ø¥ó¡A¥h "§÷®Æ" §ä¨ì¹ïÀ³ªº¼Æ¾Ú¡C
    
29.                         '  ²Ä 1 ºØ (¬Û¦P Cust (c.Value) & PKG (c.Offset(, 3))  & B/S (c.Offset(, 4)) & L/C (c.Offset(, 5)))
    
30.                         If c.Offset(, 3) = Adt_Rng.Value And c.Offset(, 4) = Adt_Rng.Offset(, 1).Value And c.Offset(, 5) = CStr(Adt_Rng.Offset(, 2).Value) Then
    
31.                             If IsEmpty(Ar2) Then ReDim Ar2(1 To 1) Else ReDim Preserve Ar2(1 To UBound(Ar2) + 1)
    
32.                             Ar2(UBound(Ar2)) = Array(c.Text, Arr(cts)(1), c.Offset(, 3).Text, c.Offset(, 4).Text, c.Offset(, 5).Text, c.Offset(, 39).Text, c.Offset(, 40).Text)
    
33.                         End If
    
34.                         
    
35.                         Set c = .[M:M].FindNext(c)
    
36.                     Loop While Not c Is Nothing And c.Address <> frstAddr
    
37.                 End If
    
38.                
    
39.                 If Not IsEmpty(Ar2) Then
    
40.                     For ct2 = LBound(Ar2) To UBound(Ar2)
    
41.                         '  ¥H ¤u§@ªí "TR±Æ¾÷&²£¥X" ªº  "F"¡B"G"¡B"H" ¬°±ø¥ó¡A ¥h ¤u§@ªí "§÷®Æ" §ä¨ì¹ïÀ³ªº¼Æ¾Ú¡F
    
42.                         '  µM«á§ä¨ì³oµ§¼Æ¾Úªº "CARRIER1 P/N"¡AµM«á¥u­n¤@¼Ë "CARRIER1 P/N" ªº³£¦C¥X¨Ó¡C
    
43.                         Set c = .[BA:BA].Find(Ar2(ct2)(6), , , 1)   '  CARRIER1 P/N ("BA")  Ar2(ct2)(6) = "4100998111" :
    
44.                         
    
45.                         If Not c Is Nothing Then   ' PKG (c.Offset(, -37)) ¡B BODU_SIZE (c.Offset(, -36))
    
46.                             frstAddr = c.Address   ' CUST_CODE (c.Offset(, -40).Text)¡B, LEAD_COUNT (c.Offset(, -35).Text)
    
47.                             Do
    
48.                                 '  ¦P¨B¦a±Æ°£­ì¥ý¦b ¤u§@ªí "TR±Æ¾÷&²£¥X" ÂI¿ïªº Package¡C(Customer¡BPackage¡BBodysize)
    
49.                                 '  ­×¥¿¥H "Cus²½X" Arr ¤§²Ä¤@²Õ (Arr(1)(0)) §@¬°§PÂ_¨Ì¾Ú¡C
    
50.                                 tf = (c.Offset(, -40).Text = Arr(1)(0) And c.Offset(, -37) = Adt_Rng.Value And c.Offset(, -36) = Adt_Rng.Offset(, 1).Value)
    
51.                                 If Ar2(ct2)(1) <> "" And tf = False Then
    
52.                                     If IsEmpty(Ar3) Then ReDim Ar3(1 To 1) Else ReDim Preserve Ar3(1 To UBound(Ar3) + 1)
    
53.                                     Ar3(UBound(Ar3)) = Array(Ar2(ct2)(1), c.Offset(, -37).Text, c.Offset(, -36).Text, c.Offset(, -35).Text, c.Text)
    
54.                                 End If
    
55. 
    
56.                                 Set c = .[BA:BA].FindNext(c)
    
57.                             Loop While Not c Is Nothing And c.Address <> frstAddr
    
58.                         End If
    
59.                     Next ct2
    
60.                 End If
    
61.             Next cts
    
62.         End With
    
63.         
    
64.         If Not IsEmpty(Ar3) Then CustPkg (Ar3)
    
65.     End If
    
66.    
    
67.     Set Arr = Nothing
    
68.     Set Ar2 = Nothing
    
69.     Set Ar3 = Nothing
    
70. End Sub

½Æ»s¥N½X

c_c_lai

¦^´_ 57# starbox520
¤T¤äµ{¦¡¬ÒÀ³©ñ¤J¨ì ¤u§@ªí³æ "TR±Æ¾÷&²£¥X" ¤º¡A
¦p¤£¦æ©p±N©pªºµ{¦¡¤W¶Ç¡A§Ú¨ÓÀ°©p¾ã²z¡C

starbox520

¦^´_ 58# c_c_lai

     ¹ï°Ú§Ú©ñ¦b¸Ì­±­C><

    TTS0000CC.rar (805.86 KB)

¤U¸ü¦¸¼Æ: 2

2016-12-2 14:36

c_c_lai

¦^´_ 59# starbox520
©p±N AuditCustPkg(Adt_Rng As Range) ­«½Æ¶K¸m¡A
AuditCustPkg(Adt_Rng As Range) ¤º¤S¦³¤@­Ó
AuditCustPkg(Adt_Rng As Range)¡C
TTS0000CC.rar (816.07 KB)

¤U¸ü¦¸¼Æ: 5

2016-12-2 15:21