[已解决]有难度的按条件取数

tianqixueyu · 发表于 2013-4-19 22:10

要求和数据均在附件中，请高手不吝赐教！多谢了！

最佳答案

月排行榜 / 总排行榜

su45

2013-4-20 01:33

咱做了个，你试试：

按条件取数.zip (19.7 KB, 下载次数: 31)

爱疯 · 发表于 2013-4-19 23:05

CV333 2013/3/1 3.6
CV333 2013/3/1 3.4

同一个物料，会出现同一个日期吗？如果会，怎么处理

su45 · 发表于 2013-4-20 01:33

咱做了个，你试试：

按条件取数.zip (19.7 KB, 下载次数: 31)

tianqixueyu · 发表于 2013-4-20 08:24

爱疯发表于 2013-4-19 23:05
CV333 2013/3/1 3.6
CV333 2013/3/1 3.4

早啊，爱疯老师，会出现在同一天的领料记录，但是不会出现同一时间段不同日期的领料记录，比如1-5日，所有的记录只会出现在1日 OR 2日，不会出现1日 AND 2日，如果有同一天的，数量相加

tianqixueyu · 发表于 2013-4-20 08:34

su45 发表于 2013-4-20 01:33
咱做了个，你试试：

早啊朋友，测试了下，A1805这个物料的领用记录没有取过来，不过已经挺好的了，能说说你的思路么？
我昨天自己想了一天都没有结果，最后弄了个原始的FOR……NEXT，速度慢到不行，所以想问问你思路。

tianqixueyu · 发表于 2013-4-20 09:05

su45 发表于 2013-4-20 01:33
咱做了个，你试试：

思路我看懂了，挺好的，就是后面的范围错了，导致A1805没取到，谢谢你，另外我想再请教下，我不要求数量合计只要求取到某天领用的第一次记录，比如我的物料DF001在3月8日第一次领用数量是6第二次领用数量是5，我只要求取到第一次领用的数。

djyjysxxs · 发表于 2013-4-20 09:33

Sub test()
'Dim d As New Dictionary, ar1(), ar2()
Dim ar1(), ar2()
Set d = CreateObject("scripting.dictionary")
With Sheets("明细表")
r% = .[A65536].End(xlUp).Row
ReDim ar2(1 To r, 1 To 13)
ar1 = .[a2].Resize(r - 1, 3).Value
End With
For i% = 1 To UBound(ar1)
  If Not d.Exists(ar1(i, 1)) Then
   d(ar1(i, 1)) = d.Count + 1
   ar2(d(ar1(i, 1)), 1) = ar1(i, 1)
  End If
  r = Int((Day(ar1(i, 2)) - 1) / 5) * 2 + 2
  If r > 12 Then r = 12
  If ar2(d(ar1(i, 1)), r + 1) = 0 Then
  ar2(d(ar1(i, 1)), r) = ar1(i, 2)
  ar2(d(ar1(i, 1)), r + 1) = ar1(i, 3)
  End If
Next
Sheet1.[a19].Resize(d.Count, 13) = ar2
End Sub

爱疯 · 发表于 2013-4-20 11:40

Sub test31()
Dim d As Object, A(), B(), i%, j%, s%, c%, n%
With Sheet2
Set d = CreateObject("scripting.dictionary")
A = .Range("A1").CurrentRegion.Value
n = 2
ReDim B(1 To UBound(A) - n, 1 To 13)
End With
s = n
For i = 2 To UBound(A)
c = (Day(A(i, 2)) + 4) \ 5
c = IIf(c > 6, 12, 2 * c) '日期的列
If d.Exists(A(i, 1)) = False Then s = s + 1: d(A(i, 1)) = s
B(s - n, 1) = A(i, 1)
B(s - n, c) = A(i, 2)
B(s - n, c + 1) = A(i, 3)
Next i
With Sheet1
.Range("a3:m65536").ClearContents
.[a3].Resize(s, UBound(B, 2)) = B
End With
End Sub

复制代码

按条件取数2.rar (9.86 KB, 下载次数: 8)

su45 · 发表于 2013-4-20 11:55

tianqixueyu 发表于 2013-4-20 09:05
思路我看懂了，挺好的，就是后面的范围错了，导致A1805没取到，谢谢你，另外我想再请教下，我不要求数量合 ...

用Range("A2:C28").SpecialCells(12).Rows(1)就可以找到第一行的数据

tianqixueyu · 发表于 2013-4-21 08:44

大家的答案都很好，爱疯老师和djyjysxxs朋友采用字典方法运行速度会快些，为了鼓励新人，我还是把最佳答案给su45 二位不要见怪，谢谢大家的回答！

		自动登录	找回密码
密码			注册