12345678910
返回列表 上一主題 發帖

[發問] 多條件篩選&ListBox

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
61# 跳轉到 »
發表於 2016-12-24 16:49 | 顯示全部帖子
回復 120# c_c_lai

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

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

  5. Dim d, k, t

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

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

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

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

  17. End With

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

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

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

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

  27.     End If

  29. Next

  31. Brr = [a1].CurrentRegion
  32.    
  33. For i = 2 To UBound(Brr) Step 5

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

  37.   If d.exists(x) Then

  39.       t = d(x)

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

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

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

  47.            For j = 0 To UBound(aa)

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

  51.            Next
  52.       Else

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

  56.        End If

  58.     End If

  60. Next
  61. '主要想設置"H"欄數量由大至小，這邊以錄製巨集使用
  62. ActiveWorkbook.Worksheets("量大未排機").AutoFilter.Sort.SortFields.Clear
  63.     ActiveWorkbook.Worksheets("量大未排機").AutoFilter.Sort.SortFields.Add Key:=Range( _
  64.         "H1:H500"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
  65.         xlSortNormal
  66.     With ActiveWorkbook.Worksheets("量大未排機").AutoFilter.Sort
  67.         .Header = xlYes
  68.         .MatchCase = False
  69.         .Orientation = xlTopToBottom
  70.         .SortMethod = xlPinYin
  71.         .Apply
  72.     End With
  73. End Sub
複製代碼

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
62#
發表於 2016-12-24 16:52 | 顯示全部帖子
回復 120# c_c_lai


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

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
63#
發表於 2016-12-24 19:13 | 顯示全部帖子
回復 125# c_c_lai


    我剛剛有測試過  
    目前是不會出事XD
    不知道狂點後會不會出事哈哈
    C大修的是什麼概念~

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
64#
發表於 2016-12-24 23:13 | 顯示全部帖子
回復 128# c_c_lai
   剩這串哈哈~~~

    我在前置作業有先處理WIP的資料 1.S欄篩出LS1T|LS1N|TR|BK|VQ 字串，其餘的不要
                                                                 2.將J欄的"G"R欄的"R"篩出來，其餘的不要
                                                                 3.'N欄的時間，以當前系統時間 + 4HRS 內 篩出來，空白無時間資料的篩出來，其餘的不要(其餘的指不在這4HRS以內的資料)
                                                                 4."U"欄急貨單號，有任何值，在"I"欄Schedule加上*號
                                                                  之後再寫到Sheet1
       這邊有一個問題是，我的用法也會更改到WIP上的資料，*號部分
       但問題在使用者，如果手殘一直點的話，這個星號會無止進的增加**********會變成一大堆...
       然後我發現我篩完後貼去Sheet1的部分，有的時候會殘留之前的資料
       ->WIP的資料每天會做更新，我試過好像要把Sheet1的資料整個刪除掉在去執行，比較不會出問題...
           這邊我是在"TR排機&產出" 做一個WIP更新的按鈕，之前有想過把這個執行也一同放入 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
         但是跑起來會很久，而且有時候顯示的資料會錯誤，因此最後才用了這個辦法...這部分有更好的作法嗎~

      配上C大之前幫忙修改的，ListBox1 & ListBox2 皆會使用到工作表2跟Shee1
      Sub ArrangeMent() 是從WIP整理過後的資料 (Sheet1)計算出來的
      就是"工作表2"
   
       寫到工作表2的部分，我把執行放到  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
       目前還沒看到錯誤，不知道放在這邊日後會不會有Bug

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
65#
發表於 2016-12-25 16:05 | 顯示全部帖子
回復 130# c_c_lai


    今天聖誕節您還是出去透透氣XD

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
66#
發表於 2016-12-26 15:05 | 顯示全部帖子

抓出我的bug

我在前置作業有先處理WIP的資料 1.S欄篩出LS1T|LS1N|TR|BK|VQ 字串，其餘的不要
                                                                 2.將J欄的"G"R欄的"R"篩出來，其餘的不要
                                                                 3.'N欄的時間，以當前系統時間 + 4HRS 內 篩出來，空白無時間資料的篩出來，其餘的不要(其餘的指不在這4HRS以內的資料)
                                                                 4."U"欄急貨單號，有任何值，在"I"欄Schedule加上*號
                                                                  之後再寫到Sheet1
       這邊有一個問題是，我的用法也會更改到WIP上的資料，*號部分
       但問題在使用者，如果手殘一直點的話，這個星號會無止進的增加**********會變成一大堆...
       然後我發現我篩完後貼去Sheet1的部分，有的時候會殘留之前的資料
       ->WIP的資料每天會做更新，我試過好像要把Sheet1的資料整個刪除掉在去執行，比較不會出問題...
           這邊我是在"TR排機&產出" 做一個WIP更新的按鈕，之前有想過把這個執行也一同放入 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
         但是跑起來會很久，而且有時候顯示的資料會錯誤，因此最後才用了這個辦法...這部分有更好的作法嗎~

      配上C大之前幫忙修改的，ListBox1 & ListBox2 皆會使用到工作表2跟Shee1
      Sub ArrangeMent() 是從WIP整理過後的資料 (Sheet1)計算出來的
      就是"工作表2"
   
       寫到工作表2的部分，我把執行放到  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
       目前還沒看到錯誤，不知道放在這邊日後會不會有Bug


PS我一直無法看到13頁以後的東西~~


tx00001223.rar (777.94 KB)

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
67#
發表於 2016-12-26 15:07 | 顯示全部帖子
回復 1# c_c_lai

C大我一直看不到您回復的><"
最我只能看到這樣~
一天了QQ

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
68#
發表於 2016-12-26 23:34 | 顯示全部帖子
回復 4# c_c_lai


    哈哈把我亂七八糟的改的好有規律
    我明天更新資料看看
    看哪邊還出錯XD

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
69#
發表於 2016-12-27 08:41 | 顯示全部帖子
  1. Sub WIP()
  2.     Dim r%, i%, Arr As Variant
  3.     Dim rng As Range, reg As New RegExp
  4.    
  5.     With reg                                 '  reg :  : RegExp/IRegExp2
  6.         .IgnoreCase = True                   '  IgnoreCase = True : Boolean
  7.         '  S 欄 (Recipe) 篩 出 LS1T | LS1N | TR | BK | VQ 字串，其餘的不要
  8.         .Pattern = "LS1T|LS1N|TR|BK|VQ"      '  Pattern = "LS1T|LS1N|TR|BK|VQ" : String
  9.     End With
  10.    
  11.     With Worksheets("WIP")
  12.         Set rng = .Rows(1)
  13.         Arr = .[A1].CurrentRegion.Value   '  Arr :  : Variant/Variant(1 to 1249, 1 to 27)
  14.         
  15.         For i = 2 To UBound(Arr)      '  UBound(Arr) = 1249 : Long
  16.            
  17.             '  (reg.test(Arr(i, 19)) : Arr(i, 19) = "TR1T0.03" (True) / = "PK1T0" (False)) : Boolean
  18.             If Arr(i, 10) = "G" And Arr(i, 18) = "R" And reg.test(Arr(i, 19)) Then
  19.                 '  N 欄 (Trackin time) 的時間，以當前系統時間 + 4HRS
  20.                 If IsDate(Arr(i, 14)) Then
  21.                     If Arr(i, 14) >= Now And Arr(i, 14) < DateAdd("h", 4, Now) Then    ' 當下時間 +4Hrs
  22.                         If Len(Arr(i, 21)) > 0 And Right(.Cells(i, 9), 1) <> "XXXXXX" Then
  23.                             .Cells(i, 9) = .Cells(i, 9) & "XXXXXX"       '  確認是否為急貨單號
  24.                         End If
  25.                         
  26.                         Set rng = Union(rng, .Rows(i))
  27.                     End If
  28.                     '  N 欄內空白無資料
  29.                 ElseIf Len(Arr(i, 14)) = 0 Then
  30.                     '  如 "U" 欄 (急貨單號)，有任何值，在 "I" 欄 (Schedule) 加上 * 號
  31.                     If Len(Arr(i, 21)) > 0 And Right(.Cells(i, 9), 1) <> "XXXXXXXX" Then
  32.                         .Cells(i, 9) = .Cells(i, 9) & "XXXXXX"
  33.                     End If
  34.                     
  35.                     Set rng = Union(rng, .Rows(i))
  36.                 End If
  37.             End If
  38.         Next
  39.     End With
  40.    
  41.     With Worksheets("Sheet1")
  42.         .[A1].CurrentRegion.ClearContents      '  清除上一次的畫面
  43.         rng.Copy .Range("A1")
  44.     End With
  45. End Sub
複製代碼
回復 4# c_c_lai


這邊我不懂意思
我不是把星號改掉了   ->   我改成XXXXX
但是秀出來一樣有星號耶~

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
70#
發表於 2016-12-27 09:13 | 顯示全部帖子
回復 4# c_c_lai


    發現空格的話
    好像就讀不到了
   

   UserForm的位置如果要讓她在螢幕正中間要改哪裡呢
  1. Private Sub UserForm_Initialize()
  2.     StartupPosition = 0
  3.     Top = 0
  4.     Left = Windows(1).Width - Width
  5.     lstSelector_設定
  6. End Sub
複製代碼

TOP

        靜思自在 : 靜坐常恩己過、閒談莫論人非。
12345678910
返回列表 上一主題