返回列表 上一主題 發帖

[發問] 多條件篩選&ListBox

回復 54# c_c_lai


    沒錯!!!!
    第一種篩法結果是對的!!!!太厲害了C大!!!!

TOP

本帖最後由 c_c_lai 於 2016-12-2 10:43 編輯
  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簡碼")
  7.         Set c = .[B:B].Find(Adt_Rng.Offset(, -1).Value, , , 1)  ' "TR排機&產出" Customer 比對 "Cus簡碼" 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簡碼" CODE 比對 "材料" CUST_CODE
  24.                
  25.                 If Not c Is Nothing Then      '  Arr(cts)(0) = "ASM" : Variant/String
  26.                     frstAddr = c.Address
  27.                     Do
  28.                         '  以 "TR排機&產出" 的  "F"、"G"、"H" 為條件,去 "材料" 找到對應的數據。
  29.                         '  第 1 種 (相同 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.                         '  以 工作表 "TR排機&產出" 的  "F"、"G"、"H" 為條件, 去 工作表 "材料" 找到對應的數據;
  42.                         '  然後找到這筆數據的 "CARRIER1 P/N",然後只要一樣 "CARRIER1 P/N" 的都列出來。
  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)) 、 BODU_SIZE (c.Offset(, -36))
  46.                             frstAddr = c.Address   ' CUST_CODE (c.Offset(, -40).Text)、, LEAD_COUNT (c.Offset(, -35).Text)
  47.                             Do  '  "BA" 欄位指的是籃子,只要是在同個籃子內的就可以,要的就是想知道用這個籃子的有哪些人。
  48.                                 '  同步地排除原先在 工作表 "TR排機&產出" 點選的 Package。(Customer、Package、Bodysize)
  49.                                 '  修正以 "Cus簡碼" Arr 之第一組 (Arr(1)(0)) 作為判斷依據。
  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簡碼")
  72.         Set c = .[B:B].Find(Adt_Rng.Offset(, -1).Value, , , 1)  ' "TR排機&產出" Customer 比對 "Cus簡碼" 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簡碼" CODE 比對 "材料" CUST_CODE
  89.                
  90.                 If Not c Is Nothing Then      '  Arr(cts)(0) = "ASM" : Variant/String
  91.                     frstAddr = c.Address
  92.                     Do
  93.                         '  以 "TR排機&產出" 的  "F"、"G"、"H" 為條件,去 "材料" 找到對應的數據。
  94.                         '  第 1 種 (相同 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.                         '  以 工作表 "TR排機&產出" 的  "F"、"G"、"H" 為條件, 去 工作表 "材料" 找到對應的數據;
  107.                         '  然後找到這筆數據的 "CARRIER1 P/N",然後只要一樣 "CARRIER1 P/N" 的都列出來。
  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)) 、 BODU_SIZE (c.Offset(, -36))
  111.                             frstAddr = c.Address   ' CUST_CODE (c.Offset(, -40).Text)、, LEAD_COUNT (c.Offset(, -35).Text)
  112.                             Do  '  "BA" 欄位指的是籃子,只要是在同個籃子內的就可以,要的就是想知道用這個籃子的有哪些人。
  113.                                 '  同步地排除原先在 工作表 "TR排機&產出" 點選的 Package。(Customer、Package、Bodysize)
  114.                                 '  修正以 "Cus簡碼" Arr 之第一組 (Arr(1)(0)) 作為判斷依據。
  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
複製代碼

a.rar (2.79 KB)

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("工作表2")
  8.         For cts = LBound(Ar3) To UBound(Ar3)
  9.             Set c = .[A:A].Find(Ar3(cts)(0), , , 1)       '  "TR排機&產出" Customer 比對 "Cus簡碼"
  10.             '  Set c = .[A:A].Find(Ar3(1)(0), , , 1)      '  "TR排機&產出" Customer 比對 "Cus簡碼"
  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
複製代碼

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
複製代碼

TOP

回復 50# starbox520
再麻煩仔細校對是否為 "第一種" 選項之正確答案:
a.rar (2.79 KB)
確定後,始能進行下一步驟的撰寫事宜。

TOP

回復 48# c_c_lai


    抱歉我還是用附檔上面提供的欄位名稱敘述好了
    我好像講給自己聽得懂的哈哈
    "TR排機&產出"  去找  "材料"   要透過"Cus簡碼"的    CODE   

     "材料"     去找"工作表2"    要透過"Cus簡碼"的    CUST_GROUP
   
   

    您的附檔,應該是正確的答案

TOP

回復 47# c_c_lai


    對壓
    你注意看,只有材料是簡碼
    TR排機&產出 找材料   需要找簡碼
    材料找工作表2又要轉全碼!!!
    附檔我研究一下下唷><

TOP

回復 46# starbox520
請核對一下附件內容是否正確。
1.rar (2.06 KB)

TOP

回復 46# starbox520
是沒轉回 (CODE -> CUST_GROUP),眼花撩亂地弄得頭暈了。

TOP

回復 45# c_c_lai

ATMEL, TQFP, 14X14, 100
此筆就有找到2個
ATMEL        TQFP        14X14        100        10495        21307        184        31986
ATMEL        TQFP        14X14        64        34295        22306        1574        58175

  C大是不是"材料"在找"工作表2"
  沒把簡碼再轉回來"全碼"??

TOP

        靜思自在 : 要用心,不要操心、煩心。
返回列表 上一主題