看到一个帖子《excel吧-数据切断分组问题》,对1列数据按指定长度进行切割分组,获取每组的长度组成方式
- VBA代码
Sub 数据分割()
Dim arr, target, brr, res, x&, y&, i&, 差额, trr(1 To 2) 'trr(0)为数值,trr(1)为组成方式
arr = [a1].CurrentRegion: target = 10: deg = 2 '待分割数据,目标值,计算精度
brr = Array(): x = -1: res = Array(): y = -1
For Each a In arr '多行多列的,按列从左往右读取
x = x + 1: ReDim Preserve brr(x): brr(x) = a
Next
Do
If trr(1) + brr(i) >= target Then
差额 = target - trr(1): trr(2) = trr(2) & "+" & CStr(差额)
y = y + 1: ReDim Preserve res(y): res(y) = Mid(trr(2), 2) '去除开头的+
trr(1) = 0: trr(2) = "": brr(i) = Round(brr(i) - 差额, deg) '更新数组
Else
trr(1) = trr(1) + brr(i): trr(2) = trr(2) & "+" & CStr(brr(i))
i = i + 1 '下一个
End If
If i < x Then '避免结果开头为0+
If brr(i) = 0 Then i = i + 1 '下一个
End If
If i = x Then '剩余部分
If brr(i) < target Then y = y + 1: ReDim Preserve res(y): res(y) = brr(i)
End If
Loop Until i > x
[d1].Resize(UBound(res) + 1, 1) = WorksheetFunction.Transpose(res)
End Sub
- 运行结果:单列、多列数据分别举例