救助按时间段查询的问题

scpfy

自己做一个简单的流水登记，每个客户一个表
现在想实现一个查询表，功能是按指定的时间区间，将所有客户（客户会不断增加，即工作表在使用过程中会有新表增加）
符合条件的数据复制到查询表中，查询表中其中“客户”一列为其他表中“备注”列修改而成，内容为客户名称（即对应的表名称）
望大侠帮忙！ 内容见附件

明细表.rar (88.23 KB, 下载次数: 2)

2018-6-22 17:32 上传

点击文件名下载附件

yaojil

不合适的话，自行修改吧

scpfy

yaojil 发表于 2018-6-22 18:05
不合适的话，自行修改吧

非常感谢！现在就是客户名称处再需要处理一下！

lsc900707

1. Sub gj23w98()
   
2.     Dim brr(1 To 10000, 1 To 11)
   
3.     Application.ScreenUpdating = False
   
4.     d1 = [e2]: d2 = [g2]
   
5.     For Each sht In Sheets
   
6.         If sht.Name <> ActiveSheet.Name Then
   
7.             arr = sht.[a1].CurrentRegion
   
8.             For i = 2 To UBound(arr)
   
9.                 If arr(i, 1) >= d1 And arr(i, 1) <= d2 Then
   
10.                     m = m + 1
    
11.                     brr(m, 1) = arr(i, 1)
    
12.                     brr(m, 2) = sht.Name
    
13.                     brr(m, 3) = arr(i, 4)
    
14.                     brr(m, 4) = arr(i, 3)
    
15.                     For j = 5 To 11
    
16.                         brr(m, j) = arr(i, j)
    
17.                     Next
    
18.                 End If
    
19.             Next
    
20.        End If
    
21.     Next
    
22.     If m Then
    
23.         [a4].CurrentRegion.Offset(1).ClearContents
    
24.         [a5].Resize(m, 11) = brr
    
25.     Else
    
26.         MsgBox "没有符合条件的数据！"
    
27.     End If
    
28.     Application.ScreenUpdating = True
    
29. End Sub
    

复制代码

lsc900707

参考附件：

scpfy

lsc900707 发表于 2018-6-23 14:48
参考附件：

谢谢！完全满足要求！！