求助：如何字串&时间筛选 谢谢

Taeng9C

筛选 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, 下载次数: 5)

2016-11-21 21:24 上传

点击文件名下载附件

jsgj2023

没看懂，关注一下。

Taeng9C

jsgj2023 发表于 2016-11-22 07:17
没看懂，关注一下。

以人工筛选的方式先在"J"栏筛“G”的资料



再到R栏筛“R”的资料

再到S栏筛有LS1T。 LS1N。 TR。 BK。 VQ的字串


  N栏 有时间资料的以现在时间 + 4小时 以外都去除掉(EX现在12点，12-16的资料留下，因WIP页面每天会更新)，空白资料留下

  若U栏有字 在 I 栏显内容后面+上 * 号( 用意是因为此栏是较紧急 ，标记在别栏引其注意 )
   整理后的结果覆盖在WIP页面上( 因为筛掉的资料都不要了)

这是否要应用到字典查找!
还请老师们帮帮我~~~~~~~!

Taeng9C

有老师愿意帮忙解答的吗QQ
或者提供一些会用到的方法~~

Taeng9C

希望老師們幫幫我...

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim rng As Range
   
5.   Dim reg As New RegExp
   
6.   With reg
   
7.     .IgnoreCase = True
   
8.     .Pattern = "LS1T|LS1N|TR|BK|VQ"
   
9.   End With
   
10.   With Worksheets("wip")
    
11.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
12.     Set rng = .Rows(1)
    
13.     arr = .Range("a1:aa" & r)
    
14.     For i = 2 To UBound(arr)
    
15.       If arr(i, 10) = "G" And arr(i, 18) = "R" And reg.test(arr(i, 19)) Then
    
16.         If IsDate(arr(i, 14)) Then
    
17.           If arr(i, 14) >= Now And arr(i, 14) < DateAdd("h", 4, Now) Then
    
18.             If Len(arr(i, 21)) <> 0 Then
    
19.               .Cells(i, 9) = .Cells(i, 9) & "*"
    
20.             End If
    
21.             Set rng = Union(rng, .Rows(i))
    
22.           End If
    
23.         End If
    
24.       End If
    
25.     Next
    
26.   End With
    
27.   With Worksheets("sheet1")
    
28.     rng.Copy .Range("a1")
    
29.   End With
    
30. End Sub
    

复制代码

chxw68

没太明白楼主的意思，供楼主参考。

Taeng9C

If IsDate(arr(i, 14)) Then
       '  If arr(i, 14) >= Now And arr(i, 14) < DateAdd("h", 4, Now) Then
老师您好 这边有办法判断如果没资料的就保留下来吗?
老师这边应该是筛选有时间，然后又在4小时里面的
保留的部分可以"4小时里" (這個老師已經達成了)& "无时间资料" 都要筛到的话呢

另外U栏的急货单号
可以判断这栏里面如果有资料的话，那一列可以整条反红
或者在那一列的其他栏位加一些注记吗?
原先我的想法是在I栏"Schedule" 资料后面多一个星号"*"
还是有比较好的方法呢?
因为未来我要设法做到ListBox上，但我翻了很多资料都没有说明ListBox可以做到我的需求

還請老師指導謝謝您

Taeng9C

chxw68 发表于 2016-11-25 19:05
没太明白楼主的意思，供楼主参考。

If IsDate(arr(i, 14)) Then
       '  If arr(i, 14) >= Now And arr(i, 14) < DateAdd("h", 4, Now) Then
老师您好 这边有办法判断如果没资料的就保留下来吗?
老师这边应该是筛选有时间，然后又在4小时里面的
保留的部分可以"4小时里" (這個老師已經達成了)& "无时间资料" 都要筛到的话呢

另外U栏的急货单号
可以判断这栏里面如果有资料的话，那一列可以整条反红
或者在那一列的其他栏位加一些注记吗?
原先我的想法是在I栏"Schedule" 资料后面多一个星号"*"
还是有比较好的方法呢?
因为未来我要设法做到ListBox上，但我翻了很多资料都没有说明ListBox可以做到我的需求

還請老師指導謝謝您

chxw68

详见附件。