返回列表 上一主題 發帖

[發問] 多條件篩選&ListBox

回復 122# starbox520

TOP

回復 118# starbox520
試試看!
  1. Private Sub CommandButton2_Click()
  2.     Dim Arr As Variant, Brr As Variant, aa As Variant, i&, j&, x$, Myr&
  3.     Dim d As Object, t As Variant

  4.     Set d = CreateObject("Scripting.Dictionary")
  5.    
  6.    
  7.     '  比對 "TR排機&產出" 灰色欄位 "E" (Customer)、 "F" (Package)、 "G" (Bodysize)、 "H" (L/C) 比對
  8.     '  "量大未排機" 找到一樣的, 秀上 "TR排機&產出" 的 "B" 欄 (機台編號) 同一列的 "機台編號"。
  9.     With Sheets("TR排機&產出")
  10.         Arr = .[A1].CurrentRegion.Value
  11.    
  12.         For i = 4 To (UBound(Arr) - 3) Step 5
  13.             If Not IsError(Arr(i, 5)) Then   '& "|" & Arr(i, 6) & "|" & Arr(i, 7) & "|" & Arr(i, 8)
  14.                  x = Arr(i, 5) & "|" & Arr(i, 6) & "|" & Arr(i, 7) & "|" & Arr(i, 8)
  15.                  d(x) = IIf(IsEmpty(d(x)), CStr(i), d(x) & "," & CStr(i))
  16.             End If
  17.         Next
  18.     End With

  19.     With Sheets("量大未排機")
  20.         Brr = .[A1].CurrentRegion
  21.         
  22.         For i = 2 To UBound(Brr)
  23.             x = Brr(i, 1) & "|" & Brr(i, 2) & "|" & Brr(i, 3) & "|" & Brr(i, 4)
  24.             
  25.             If d.exists(x) Then
  26.                 t = d(x)
  27.                
  28.                 If InStr(t, ",") Then
  29.                     aa = Split(t, ",")
  30.                     
  31.                     For j = 0 To UBound(aa)
  32.                         .Cells(i, 9 + j) = Arr(aa(j), 2)
  33.                     Next
  34.                 Else
  35.                     .Cells(i, 9) = Arr(t, 2)
  36.                 End If
  37.             End If
  38.         Next
  39.         
  40.         '  主要想設置 "H" (數量) 欄 數量由大至小,這邊以錄製巨集使用
  41.         .AutoFilter.Sort.SortFields.Clear
  42.         .AutoFilter.Sort.SortFields.Add Key:=Range( _
  43.                 "H1:H500"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
  44.                 xlSortNormal
  45.         
  46.         With .AutoFilter.Sort
  47.             .Header = xlYes
  48.             .MatchCase = False
  49.             .Orientation = xlTopToBottom
  50.             .SortMethod = xlPinYin
  51.             .Apply
  52.         End With
  53.     End With
  54. End Sub
複製代碼

TOP

回復 120# c_c_lai


    這問題佔了好多的樓層  
    搞到我連我回復的帖都看不到了XD
    C大有其他可以回復的地方嗎~
    我們處理完丟結果上來好像比較不佔空間...

TOP

回復 120# c_c_lai

附檔中我有加入這個按鈕
如果比對相同的話
我會秀那一欄的機台"編號"
口誤啦Q0Q

  1. Private Sub CommandButton2_Click()
  2. Sheets("量大未排機").Select
  3. Dim Arr, i&, Brr, aa, j&, x$, Myr&

  4. Dim d, k, t

  5. Set d = CreateObject("Scripting.Dictionary")

  6. Sheets("量大未排機").Activate
  7. '比對"TR排機&產出" 灰色欄位"E""F""G""H"比對"量大未排機"找到一樣的,秀上"TR排機&產出"的"B"欄同一列的機台編號
  8. With Sheets("TR排機&產出")

  9.     Myr = .Cells(.Rows.Count, 12).End(xlUp).Row

  10.     Arr = .Range("a1:p" & Myr)

  11. End With

  12. For i = 4 To UBound(Arr) Step 5

  13.     If Not IsError(Arr(i, 5)) Then   '& "|" & Arr(i, 6) & "|" & Arr(i, 7) & "|" & Arr(i, 8)

  14.     x = Arr(i, 5) & "|" & Arr(i, 6) & "|" & Arr(i, 7) & "|" & Arr(i, 8)

  15.     d(x) = d(x) & i & ","

  16.     End If

  17. Next

  18. Brr = [a1].CurrentRegion
  19.    
  20. For i = 2 To UBound(Brr) Step 5

  21.    x = Brr(i, 1) & "|" & Brr(i, 2) & "|" & Brr(i, 3) & "|" & Brr(i, 4)

  22.   If d.exists(x) Then

  23.       t = d(x)

  24.         t = Left(t, Len(t) - 1)

  25.        If InStr(t, ",") Then

  26.            aa = Split(t, ",")

  27.            For j = 0 To UBound(aa)

  28.                Cells(i, 9 + j) = Arr(aa(j), 2)

  29.            Next
  30.       Else

  31.            Cells(i, 9) = Arr(t, 2)

  32.        End If

  33.     End If

  34. Next
  35. '主要想設置"H"欄數量由大至小,這邊以錄製巨集使用
  36. ActiveWorkbook.Worksheets("量大未排機").AutoFilter.Sort.SortFields.Clear
  37.     ActiveWorkbook.Worksheets("量大未排機").AutoFilter.Sort.SortFields.Add Key:=Range( _
  38.         "H1:H500"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
  39.         xlSortNormal
  40.     With ActiveWorkbook.Worksheets("量大未排機").AutoFilter.Sort
  41.         .Header = xlYes
  42.         .MatchCase = False
  43.         .Orientation = xlTopToBottom
  44.         .SortMethod = xlPinYin
  45.         .Apply
  46.     End With
  47. End Sub
複製代碼

TOP

回復 119# c_c_lai


    換我眼花了我沒看到這行哈哈...
    剛剛測試過了!!
    沒錯哈哈~

TOP

回復 118# starbox520
又、"量大未排機" 的機台號碼 是從那裡冒出來的?

TOP

回復 118# starbox520
那 #116 上有關 BGA、QFN、QFP 的程式部分,
妳測試的結果是不是如你所願?

TOP

回復 117# c_c_lai


    這邊的部分是我  例如你看到SQH191
    他不可能出現在兩筆數據上面~
    如果使用者手殘,一直點按鈕的話
    就會出現這種Bug
    但我試過debug原因好像是出在我後面IJKL欄  不會先Clear掉~"~
    導致每次按鈕按下去比對的時候
    會出現錯亂哈哈
    我有個想法就是我在ArrangeMent這邊
  1. If N = 0 Then Exit Sub
  2.     With Sheets("工作表2")
  3.    .[A2].Resize(N, 8) = Brr
  4.   
  5. End With
  6. If N = 0 Then Exit Sub
  7.     With Sheets("量大未排機")
  8.    .[A2].Resize(N, 8) = Brr
  9.    End With
  10. End Sub
複製代碼
量大未排機部分
改成   .[A2].Resize(N, 12) = Brr
這樣每次就會更新到後面這4行
在按下我設計的"量大未排機"按鈕
似乎就比較不會出錯
不過這只是我的想法XD...
因為我發現這樣改的話後面會變成跑"N/A"出來


所以C大懂我BGA.QFN.QFP  這3種特殊的狀況做判斷
再說什麼了嗎哈哈

TOP

回復 101# starbox520

TOP

回復 111# starbox520
  1.                 Select Case cts
  2.                     Case 3      '  第 3 種篩選方式: TR排機&產出    E F G H   (工作表2        A B C D)
  3.                         '  tf = arSh2(ct2, 1) = Adt_Rng.Offset(, -1) And arSh2(ct2, 2) = Adt_Rng.Value And arSh2(ct2, 3) = Adt_Rng.Offset(, 1) And arSh2(ct2, 4) = Adt_Rng.Offset(, 2)
  4.                         tf = arSh2(ct2, 1) = Adt_Rng.Offset(, -1) And Right(arSh2(ct2, 2), 3) = Right(Adt_Rng.Value, 3) And arSh2(ct2, 3) = Adt_Rng.Offset(, 1) And arSh2(ct2, 4) = Adt_Rng.Offset(, 2)
  5.                     Case 4      '  第 4 種篩選方式: TR排機&產出      F G H   (工作表2          B C D)
  6.                         '  tf = arSh2(ct2, 2) = Adt_Rng.Value And arSh2(ct2, 3) = Adt_Rng.Offset(, 1) And arSh2(ct2, 4) = Adt_Rng.Offset(, 2)
  7.                         tf = Right(arSh2(ct2, 2), 3) = Right(Adt_Rng.Value, 3) And arSh2(ct2, 3) = Adt_Rng.Offset(, 1) And arSh2(ct2, 4) = Adt_Rng.Offset(, 2)
  8.                     Case 5      '  第 5 種篩選方式: TR排機&產出      F G     (工作表2          B C  )
  9.                         '  tf = arSh2(ct2, 2) = Adt_Rng.Value And arSh2(ct2, 3) = Adt_Rng.Offset(, 1)
  10.                         tf = Right(arSh2(ct2, 2), 3) = Right(Adt_Rng.Value, 3) And arSh2(ct2, 3) = Adt_Rng.Offset(, 1)
  11.                 End Select
複製代碼

TOP

        靜思自在 : 能幹不幹,不如苦幹實幹。
返回列表 上一主題