[發問] 字串&時間篩選

starbox520

篩選 J欄  塞選只有 G 的資料
    R欄   塞選只有 R 的資料
    S欄   塞選有 LS1T . LS1N . TR . BK . VQ 的字串
    N欄  有時間資料的以現在時間 + 4小時 以外都去除掉(EX現在12點，12-16的資料留下，因WIP頁面每天會更新)，空白資料留下
    若U欄有字 在 I 欄顯內容後面+上 * 號( 用意是因為此欄是較緊急  ，標記在別欄引其注意 )
    整理後的結果覆蓋在WIP頁面上(  因為篩掉的資料都不要了)

    再把WIP整理好的結果用在已寫好的程式碼

1. Sub ArrangeMent()
   
2. 
   
3. Dim Arr, Brr, xD, Dn&, T$, N&, i&, j%
   
4. Arr = Range([WIP!A1], [WIP!A1].Cells(Rows.Count, 1).End(xlUp)(1, 12))
   
5. Set xD = CreateObject("Scripting.Dictionary")
   
6. ReDim Brr(1 To UBound(Arr), 1 To 8)
   
7.    For i = 2 To UBound(Arr)
   
8.    T = Arr(i, 1) & "|" & Arr(i, 5) & "|" & Arr(i, 7) & "|" & Arr(i, 6)
   
9.    Dn = xD(T)
   
10.    If Dn = 0 Then
    
11.       N = N + 1: Dn = N: xD(T) = N
    
12.       For j = 1 To 4: Brr(Dn, j) = Arr(i, Array(1, 5, 7, 6)(j - 1)): Next
    
13.    End If
    
14.     j = Int(InStr("----BK-VM-TR-", "-" & Split(Arr(i, 3), "_")(1) & "-") / 3)
    
15.      If j > 0 Then
    
16.       Brr(Dn, j + 4) = Brr(Dn, j + 4) + Arr(i, 11)
    
17.        Brr(Dn, 8) = Brr(Dn, 8) + Arr(i, 11)
    
18.      End If
    
19. Next i
    
20. If N = 0 Then Exit Sub
    
21.     With Sheets("工作表2")
    
22.    .[A2].Resize(N, 8) = Brr
    
23.   
    
24. End With
    
25. End Sub

複製代碼

TX00001.zip (341.42 KB)

下載次數: 7

2016-11-21 18:01