按期间查询数据

ericxzhou

1. Sub test()
   
2.     Dim d, i%, j%, k%, arr1, arr2
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Sheets("销售明细").Activate
   
5.     For i = 2 To [a65535].End(3).Row
   
6.         d(Cells(i, 2).Value) = d(Cells(i, 2).Value) & i & ","
   
7.     Next
   
8.     arr1 = d.keys
   
9.     Sheets("查询表").Activate
   
10.     Range("a9:n" & Sheets("查询表").UsedRange.Rows.Count + 1).ClearContents
    
11.     k = 9
    
12.     For i = 0 To UBound(arr1)
    
13.         If arr1(i) = [c4].Value Then
    
14.             d(arr1(i)) = Left(d(arr1(i)), Len(d(arr1(i))) - 1)
    
15.             arr2 = Split(d(arr1(i)), ",")
    
16.             For j = 0 To UBound(arr2)
    
17.                 With Sheets("销售明细")
    
18.                     If .Cells(arr2(j), 1) >= [k4] And _
    
19.                         .Cells(arr2(j), 1) <= [n4] Then
    
20.                         Cells(k, 1) = k - 8: Cells(k, 2) = .Cells(arr2(j), 1)
    
21.                         Cells(k, 3) = .Cells(arr2(j), 4): Cells(k, 4) = .Cells(arr2(j), 5)
    
22.                         Cells(k, 5) = .Cells(arr2(j), 6): Cells(k, 6) = .Cells(arr2(j), 10)
    
23.                         Cells(k, 7) = .Cells(arr2(j), 7): Cells(k, 8) = .Cells(arr2(j), 10)
    
24.                         Cells(k, 9) = .Cells(arr2(j), 9)
    
25.                     End If
    
26.                 End With
    
27.                 k = k + 1
    
28.             Next
    
29.         End If
    
30.     Next
    
31.     d.RemoveAll
    
32.     Sheets("回款明细").Activate
    
33.     For i = 2 To [a65535].End(3).Row
    
34.         d(Cells(i, 3).Value) = d(Cells(i, 3).Value) & i & ","
    
35.     Next
    
36.     arr1 = d.keys
    
37.     Sheets("查询表").Activate
    
38.     k = 9
    
39.     For i = 0 To UBound(arr1)
    
40.         If arr1(i) = [c4].Value Then
    
41.             d(arr1(i)) = Left(d(arr1(i)), Len(d(arr1(i))) - 1)
    
42.             arr2 = Split(d(arr1(i)), ",")
    
43.             For j = 0 To UBound(arr2)
    
44.                 With Sheets("回款明细")
    
45.                     If .Cells(arr2(j), 1) >= [k4] And _
    
46.                         .Cells(arr2(j), 1) <= [n4] Then
    
47.                         Cells(k, 10) = .Cells(arr2(j), 1): Cells(k, 11) = .Cells(arr2(j), 7)
    
48.                         Cells(k, 12) = .Cells(arr2(j), 8): Cells(k, 13) = .Cells(arr2(j), 9)
    
49.                     End If
    
50.                 End With
    
51.                 k = k + 1
    
52.             Next
    
53.         End If
    
54.     Next
    
55. End Sub

复制代码

2datou

少如 发表于 2021-5-12 08:22
数据万余行， 用公式会卡顿， 您能给一个合适的公式吗？
谢谢！

=FILTER(销售明细!$A$2:$K$2957,(销售明细!B2:B2957=查询表!C4)*(销售明细!A2:A2957>查询表!K4)*(销售明细!A2:A2957<查询表!N4))
这是对销售明细表的筛选，细节自己调整。你的数据量用filter是感觉不到卡的，如果卡就换电脑吧

shiruiqiang

Sub cs()
Application.ScreenUpdating = False
Dim arr, brr, arr1(1 To 100000, 1 To 8)
arr = Sheets("销售明细").UsedRange
brr = Sheets("回款明细").UsedRange
Sheets("查询表").Range("a9:n10000").Clear
Dim i, x, y, k, j
i = 8
For x = 1 To UBound(arr)
arr1(x, 1) = Array(arr(x, 1), arr(x, 4), arr(x, 5), arr(x, 6), arr(x, 10), arr(x, 7), arr(x, 11), arr(x, 9))
If arr(x, 2) Like Sheets("查询表").Range("c4") And arr(x, 1) >= Sheets("查询表").Range("k4") And arr(x, 1) <= Sheets("查询表").Range("n4") Then
i = i + 1
Sheets("查询表").Range("a" & i) = i - 8
Sheets("查询表").Range("b" & i).Resize(1, 8) = arr1(x, 1)
End If
Next
Application.ScreenUpdating = True
MsgBox "ok"
End Sub
回款明细按照上面修改一下吧

少如

2datou 发表于 2021-5-12 11:36
=FILTER(销售明细!$A$2:$K$2957,(销售明细!B2:B2957=查询表!C4)*(销售明细!A2:A2957>查询表!K4)*(销售明 ...

显示[此函数无效]  ?

少如

ericxzhou 发表于 2021-5-12 11:29

老师:
金额不对,似乎与单价拦相同? 请您再给看看
. 谢谢!
应收款录入与查询 - 副本.zip (351.09 KB, 下载次数: 1)

2021-5-12 13:12 上传

点击文件名下载附件

少如

shiruiqiang 发表于 2021-5-12 12:11
Sub cs()
Application.ScreenUpdating = False
Dim arr, brr, arr1(1 To 100000, 1 To 8)

学生不 懂VBA, 您受累把他写完吧.  谢谢!

少如

沉的好快呀!    顶上来,    就差一点点了

gugudeai

看下效果是否满足

gugudeai

少如 发表于 2021-5-12 12:21
显示[此函数无效]  ?

哈哈 我用的office2003就不支持这个函数

少如

ericxzhou 发表于 2021-5-12 11:29

谢谢 ericxzhou 老师 ! 己经改好了!