请教老师：求同日期的平均比值，谢谢！

lwx228

lsc900707 发表于 2018-11-19 16:02
晚点再看看是什么原因造成的误差！

谢谢版主，
奇怪就是部分不符，我也仔细检查了，未找到原因。

太麻烦您 了。谢谢！

lwx228

估计是这里
br(i, 1) = Application.Round(arr(i, 2) / (d(s) / d1(s)), 3)

这个可能要最后要搞个独立的循环才能正确计算，否则同一日期开始的结果是不正确的。

lwx228

Sub gj23w98()
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    arr = Range("a2:b" & Cells(Rows.Count, "a").End(3).Row): ReDim br(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        s = Format(arr(i, 1), "yyyy-m-d")
        If arr(i, 1) <> "" Then
            d(s) = d(s) + arr(i, 2)
            d1(s) = d1(s) + 1
        End If
    Next
     For i = 1 To UBound(arr)
          s = Format(arr(i, 1), "yyyy-m-d"):  br(i, 1) = Application.Round(arr(i, 2) / (d(s) / d1(s)), 3)
    Next
    Cells(2, "c").Resize(UBound(br), 1) = br
End Sub

lwx228

帖子审&核时间超长

zopey

Sub test2()
Dim arr(), k0

Set cnn = CreateObject("adodb.connection")
cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName

sql2 = "select format(日期,'yyyy-m-d') as 日期2,sum(数据)/count(*) as 平均数 from [sheet1$a:b] group by format(日期,'yyyy-m-d')"
sql2 = "select * from [sheet1$a:b] a left join (" & sql2 & ") b on format(a.日期,'yyyy-m-d')=b.日期2"

Set rst2 = CreateObject("adodb.Recordset")
rst2.Open sql2, cnn, 1, 1

    k0 = rst2.RecordCount
    ReDim arr(1 To k0, 1 To 1)
    Do While Not rst2.EOF
       k = k + 1
       arr(k, 1) = rst2("数据") / rst2("平均数")
    rst2.movenext
    Loop

cnn.Close
Set cnn = Nothing

[d2].Resize(k0, 1) = arr
End Sub

lsc900707

lwx228 发表于 2018-11-19 16:22
Sub gj23w98()
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scriptin ...

快下班了匆匆忙忙写的，修改如下：

1. Sub gj23w98()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     arr = [a1].CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         s = Format(arr(i, 1), "yyyymmdd")
   
7.         If arr(i, 1) <> "" Then
   
8.             d(s) = d(s) + arr(i, 2)
   
9.             d1(s) = d1(s) + 1
   
10.         End If
    
11.     Next
    
12.     For i = 2 To UBound(arr)
    
13.         s = Format(arr(i, 1), "yyyymmdd")
    
14.         If d.exists(s) Then arr(i, 3) = Application.Round(arr(i, 2) / (d(s) / d1(s)), 3)
    
15.     Next
    
16.     [a1].CurrentRegion = arr
    
17. End Sub

复制代码

lsc900707

lwx228 发表于 2018-11-19 16:22
Sub gj23w98()
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scriptin ...

对自己代码不严谨造成困扰深表歉意。请参考附件：