急求统计大于某个日期的指定名称的合计数量，谢过高手们了

woaixiaoqian

如题，就是统计入库日期大于采购日期的商品名称的入库数量，就是采购日期以前入库的就不参与统计了，然后对比采购数量，得出采购的进度，为部分完成还是已经完成。。先谢过高手了，用vba怎么做啊。。。谢谢大家了

zax010

Sub zz()
    Dim d, d1, arr, brr
    Set d = CreateObject("Scripting.Dictionary")
    Set d1 = CreateObject("Scripting.Dictionary")
    arr = Sheet1.Range("A3").CurrentRegion
    brr = Sheet2.Range("A1").CurrentRegion
    For i = 2 To UBound(brr)
        d1(brr(i, 1)) = brr(i, 7)
    Next
    For i = 2 To UBound(arr)
        If arr(i, 9) > d1(arr(i, 4)) Then
            d(arr(i, 4)) = d(arr(i, 4)) + arr(i, 6)
        End If
    Next
    With Sheet2
        For i = 2 To .[a65536].End(3).Row
            If d(.Cells(i, 1).Value) >= .Cells(i, 3).Value Then .Cells(i, 9) = "已完成"
            If d(.Cells(i, 1).Value) < .Cells(i, 3).Value Then .Cells(i, 9) = "部分完成"
            If .Cells(i, 8) = "" Then .Cells(i, 9) = "未完成"
        Next
    End With
End Sub

byhyxb

是否要求效果：
急求统计某个日期后入库的数量.rar (14.34 KB, 下载次数: 39)

2014-6-14 16:18 上传

点击文件名下载附件

zax010

参考附件：

急求统计某个日期后入库的数量.rar (14.55 KB, 下载次数: 41)

2014-6-14 16:21 上传

点击文件名下载附件

chxw68

试着用ADO+SQL做了一个。

1. Sub test()
   
2.   Dim cnn As New ADODB.Connection
   
3.   Dim rs As New ADODB.Recordset
   
4.   Dim sql As String
   
5.   
   
6.   Dim mybook As String
   
7.   
   
8.   mybook = ThisWorkbook.FullName
   
9.   
   
10.   With cnn
    
11.     .Provider = "microsoft.jet.oledb.4.0"
    
12.     .ConnectionString = "extended properties=""excel 8.0;HDR=YES;"";data source=" & mybook
    
13.     .Open
    
14.   End With
    
15.   sql = "select a.物料名称 as 物料名称,sum(b.数量) as 数量 from [采购进度$a1:i] a left outer join [入库表$a3:j] b on a.物料名称=b.名称 where b.日期>a.采购日期 group by a.物料名称"
    
16.   sql = "select b.数量,iif(isnull(b.数量),'未完成',iif(a.采购数量>b.数量,'部分完成','已完成')) as 情况 from [采购进度$a1:i] a left outer join (" & sql & ") b on a.物料名称=b.物料名称"
    
17.   rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
    
18.   With Worksheets("采购进度")
    
19.     .Range("h2").CopyFromRecordset rs
    
20.   End With
    
21. End Sub
    

复制代码

chxw68

纯粹是试验性质的，供参考。

gbgbxgb

fasfdfdsfdasfdsfdsaf

1. Sub 统计采购进度()
   
2.     Dim arr As Variant, brr As Variant, crr() As Variant, theSum#
   
3.     Dim theStr1$, theStr2$, theDate1 As Date, theDate2 As Date, i&, j&, theFinalRow&
   
4.     arr = Sheet2.Cells(1).CurrentRegion '采购进度表
   
5.     If TypeName(arr) <> "Variant()" Then Exit Sub
   
6.     ReDim crr(1 To UBound(arr), 1 To 2)
   
7.     crr(1, 1) = arr(1, 8) '标题“到库数量”
   
8.     crr(1, 2) = arr(1, 9) '标题“采购进度情况”
   
9.     With Sheet1 '入库表
   
10.         theFinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.         If theFinalRow < 4 Then Exit Sub '前3行为标题行
    
12.         brr = .Range(.Cells(3, 1), .Cells(theFinalRow, 9))
    
13.     End With
    
14.     If TypeName(brr) <> "Variant()" Then Exit Sub
    
15.     For i = 2 To UBound(arr)
    
16.         theSum = 0
    
17.         theStr1 = arr(i, 1)
    
18.         If theStr1 <> "" Then
    
19.             theDate1 = arr(i, 7)
    
20.             For j = 2 To UBound(brr) '数组第1行为标题行
    
21.                 theStr2 = brr(j, 4)
    
22.                 If theStr2 = theStr1 Then
    
23.                     theDate2 = brr(j, 9)
    
24.                     If theDate2 >= theDate1 Then theSum = theSum + brr(j, 6)
    
25.                 End If
    
26.             Next j
    
27.         End If
    
28.         If arr(i, 3) > 0 Then '第3列为计划采购数量
    
29.             If theSum >= arr(i, 3) Then
    
30.                 crr(i, 1) = theSum
    
31.                 crr(i, 2) = "已完成"
    
32.             Else
    
33.                 If theSum = 0 Then
    
34.                     crr(i, 2) = "未完成"
    
35.                 Else
    
36.                     crr(i, 1) = theSum
    
37.                     crr(i, 2) = "部分完成"
    
38.                 End If
    
39.             End If
    
40.         Else
    
41.             If theSum > 0 Then crr(i, 1) = theSum
    
42.             crr(i, 2) = "乱七八糟"
    
43.         End If
    
44.     Next i
    
45.     Sheet2.Cells(1, 8).Resize(UBound(crr), UBound(crr, 2)) = crr
    
46. End Sub
    

复制代码

woaixiaoqian

太感谢各位了，谢谢大家，问题解决了

№琏＼翘

woaixiaoqian 发表于 2014-6-14 18:47
太感谢各位了，谢谢大家，问题解决了

怎么解决的，教教我