|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
参与一下。。。- Sub ykcbf() '//2024.9.12
- Set d = CreateObject("Scripting.Dictionary")
- r = Cells(Rows.Count, 2).End(3).Row
- arr = [a1].Resize(r, 2)
- For i = 2 To UBound(arr)
- If arr(i, 1) <> Empty And arr(i, 2) = Empty Then k = k + 1: d(k) = i
- Next
- ReDim brr(1 To d.Count, 1 To 2)
- On Error Resume Next
- For k = 1 To d.Count
- r1 = d(k)
- If k = d.Count Then r2 = r Else r2 = d(k + 1) - 1
- m = m + 1
- n = 0
- brr(m, 1) = arr(r1, 1)
- Sum = 0
- For i = r1 + 2 To r2
- n = n + 1
- Sum = Sum + CDate(arr(i, 2)) - CDate(arr(i - 1, 2))
- Next
- brr(m, 2) = Sum / n
- Next
- [d2:d10000] = ""
- [d2].Resize(m, 2) = brr
- MsgBox "OK!"
- End Sub
复制代码
|
|