ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦h±ø¥ó¿z¿ï&ListBox

¦^´_ 50# starbox520
¦A³Â·Ð¥J²Ó®Õ¹ï¬O§_¬° "²Ä¤@ºØ" ¿ï¶µ¤§¥¿½Tµª®×¡G
a.rar (2.79 KB)
½T©w«á¡A©l¯à¶i¦æ¤U¤@¨BÆJªº¼¶¼g¨Æ©y¡C

TOP

¦^´_ 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.         AuditCustPkg (Cells(Target(1).Row, "F"))

  9.         If IsEmpty(Sh_Ar) Then MsgBox Sh_Rng & "-" & Sh_Rng(1, 2) & vbLf & "§ä¤£¨ì": Exit Sub
  10.         Unload frmSelector
  11.         frmSelector.Show False
  12.     Else
  13.         Unload frmSelector
  14.     End If
  15. End Sub
½Æ»s¥N½X

TOP

  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

TOP

¥»©«³Ì«á¥Ñ c_c_lai ©ó 2016-12-2 10:43 ½s¿è
  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.                                 Set c = .[BA:BA].FindNext(c)
  56.                             Loop While Not c Is Nothing And c.Address <> frstAddr
  57.                         End If
  58.                     Next ct2
  59.                 End If
  60.             Next cts
  61.         End With
  62.         
  63.         If Not IsEmpty(Ar3) Then CustPkg (Ar3)
  64.     End If
  65.    
  66. Sub AuditCustPkg(Adt_Rng As Range)
  67.     Dim c As Range, frstAddr As String, tf As Boolean
  68.     Dim cts As Integer, ct2 As Integer
  69.     Dim Arr As Variant, Ar2 As Variant, Ar3 As Variant
  70.    
  71.     With Sheets("Cus²½X")
  72.         Set c = .[B:B].Find(Adt_Rng.Offset(, -1).Value, , , 1)  ' "TR±Æ¾÷&²£¥X" Customer ¤ñ¹ï "Cus²½X" CUST_GROUP
  73.         
  74.         If Not c Is Nothing Then
  75.             frstAddr = c.Address
  76.             Do
  77.                 If IsEmpty(Arr) Then ReDim Arr(1 To 1) Else ReDim Preserve Arr(1 To UBound(Arr) + 1)
  78.                 Arr(UBound(Arr)) = Array(c.Offset(, -1).Text, c.Text)
  79.                
  80.                 Set c = .[B:B].FindNext(c)
  81.             Loop While Not c Is Nothing And c.Address <> frstAddr
  82.         End If
  83.     End With
  84.    
  85.     If Not IsEmpty(Arr) Then
  86.         With Sheets("§÷®Æ")
  87.             For cts = LBound(Arr) To UBound(Arr)
  88.                 Set c = .[M:M].Find(Arr(cts)(0), , , 1)      '  "Cus²½X" CODE ¤ñ¹ï "§÷®Æ" CUST_CODE
  89.                
  90.                 If Not c Is Nothing Then      '  Arr(cts)(0) = "ASM" : Variant/String
  91.                     frstAddr = c.Address
  92.                     Do
  93.                         '  ¥H "TR±Æ¾÷&²£¥X" ªº  "F"¡B"G"¡B"H" ¬°±ø¥ó¡A¥h "§÷®Æ" §ä¨ì¹ïÀ³ªº¼Æ¾Ú¡C
  94.                         '  ²Ä 1 ºØ (¬Û¦P Cust (c.Value) & PKG (c.Offset(, 3))  & B/S (c.Offset(, 4)) & L/C (c.Offset(, 5)))
  95.                         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
  96.                             If IsEmpty(Ar2) Then ReDim Ar2(1 To 1) Else ReDim Preserve Ar2(1 To UBound(Ar2) + 1)
  97.                             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)
  98.                         End If
  99.                         
  100.                         Set c = .[M:M].FindNext(c)
  101.                     Loop While Not c Is Nothing And c.Address <> frstAddr
  102.                 End If
  103.                
  104.                 If Not IsEmpty(Ar2) Then
  105.                     For ct2 = LBound(Ar2) To UBound(Ar2)
  106.                         '  ¥H ¤u§@ªí "TR±Æ¾÷&²£¥X" ªº  "F"¡B"G"¡B"H" ¬°±ø¥ó¡A ¥h ¤u§@ªí "§÷®Æ" §ä¨ì¹ïÀ³ªº¼Æ¾Ú¡F
  107.                         '  µM«á§ä¨ì³oµ§¼Æ¾Úªº "CARRIER1 P/N"¡AµM«á¥u­n¤@¼Ë "CARRIER1 P/N" ªº³£¦C¥X¨Ó¡C
  108.                         Set c = .[BA:BA].Find(Ar2(ct2)(6), , , 1)   '  CARRIER1 P/N ("BA")  Ar2(ct2)(6) = "4100998111" : Variant/String
  109.                         
  110.                         If Not c Is Nothing Then   ' PKG (c.Offset(, -37)) ¡B BODU_SIZE (c.Offset(, -36))
  111.                             frstAddr = c.Address   ' CUST_CODE (c.Offset(, -40).Text)¡B, LEAD_COUNT (c.Offset(, -35).Text)
  112.                             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
  113.                                 '  ¦P¨B¦a±Æ°£­ì¥ý¦b ¤u§@ªí "TR±Æ¾÷&²£¥X" ÂI¿ïªº Package¡C(Customer¡BPackage¡BBodysize)
  114.                                 '  ­×¥¿¥H "Cus²½X" Arr ¤§²Ä¤@²Õ (Arr(1)(0)) §@¬°§PÂ_¨Ì¾Ú¡C
  115.                                 tf = (c.Offset(, -40).Text = Arr(1)(0) And c.Offset(, -37) = Adt_Rng.Value And c.Offset(, -36) = Adt_Rng.Offset(, 1).Value)
  116.                                 If Ar2(ct2)(1) <> "" And tf = False Then
  117.                                     If IsEmpty(Ar3) Then ReDim Ar3(1 To 1) Else ReDim Preserve Ar3(1 To UBound(Ar3) + 1)
  118.                                     Ar3(UBound(Ar3)) = Array(Ar2(ct2)(1), c.Offset(, -37).Text, c.Offset(, -36).Text, c.Offset(, -35).Text, c.Text)
  119.                                 End If

  120.                                 Set c = .[BA:BA].FindNext(c)
  121.                             Loop While Not c Is Nothing And c.Address <> frstAddr
  122.                         End If
  123.                     Next ct2
  124.                 End If
  125.             Next cts
  126.         End With
  127.         
  128.         If Not IsEmpty(Ar3) Then CustPkg (Ar3)
  129.     End If
  130.    
  131.     Set Arr = Nothing
  132.     Set Ar2 = Nothing
  133.     Set Ar3 = Nothing
  134. End Sub
½Æ»s¥N½X

a.rar (2.79 KB)

TOP

¦^´_ 54# c_c_lai


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

TOP

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

TOP

¦^´_ 56# c_c_lai


   
     ¨º£°¦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.                                 Set c = .[BA:BA].FindNext(c)
  56.                             Loop While Not c Is Nothing And c.Address <> frstAddr
  57.                         End If
  58.                     Next ct2
  59.                 End If
  60.             Next cts
  61.         End With
  62.         
  63.         If Not IsEmpty(Ar3) Then CustPkg (Ar3)
  64.     End If
  65.    
  66.     Set Arr = Nothing
  67.     Set Ar2 = Nothing
  68.     Set Ar3 = Nothing
  69. End Sub
½Æ»s¥N½X

TOP

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

TOP

¦^´_ 58# c_c_lai

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

    TTS0000CC.rar (805.86 KB)

TOP

¦^´_ 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)

TOP

        ÀR«ä¦Û¦b : ¸Ü¦h¤£¦p¸Ü¤Ö¡A¸Ü¤Ö¤£¦p¸Ü¦n¡C
ªð¦^¦Cªí ¤W¤@¥DÃD