Board logo

標題: [發問] 字串&時間篩選 [打印本頁]

作者: starbox520    時間: 2016-11-21 18:05     標題: 字串&時間篩選

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




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)