|
楼主,按您意思做了,您试试看吧。
- Public Sub Test()
- Dim D As Object, Sh As Worksheet, Sh2 As Worksheet
- Dim Lr&, i&, r1&, r2& 'r1、r2分别代表同一天里的行首和行尾
- Set D = CreateObject("Scripting.Dictionary") '在本例中,利用数组记录数据,比用数组方便一些
- D("日期") = "平均值" '表头
- Set Sh = ThisWorkbook.Sheets(1)
- Lr = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row '最后一行
- r1 = 1
- For i = 2 To Lr
- If DateDiff("D", Sh.Cells(i - 1, 1), Sh.Cells(i, 1)) <> 0 Then
- r2 = i - 1
- D(DateValue(Sh.Cells(r1, 1))) = Application.Average(Sh.Range(Sh.Cells(r1, "C"), Sh.Cells(r2, "H"))) '利用工作表函数取平均值是最快的
- r1 = i
- End If
- Next i
- '待上面的循环结束后,还要取一下最后一个日期的平均值
- D(DateValue(Sh.Cells(r1, 1))) = Application.Average(Sh.Range(Sh.Cells(r1, "C"), Sh.Cells(Lr, "H")))
- Set Sh2 = Sheets.Add '新建工作表
- Sh2.[A1].Resize(D.Count, 2) = Application.Transpose(Array(D.Keys, D.Items)) '将字典输出到新工作表中
- End Sub
复制代码
|
|