Excel·VBA指定目标值切割分组

看到一个帖子《excel吧-数据切断分组问题》,对1列数据按指定长度进行切割分组,获取每组的长度组成方式

  • VBA代码
vbnet 复制代码
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
  • 运行结果:单列、多列数据分别举例

相关推荐
chatexcel18 小时前
不用写 SQL,如何用AI直连数据库生成可刷新的数据看板?ChatExcel的一种实践
大数据·数据库·人工智能·sql·数据分析·excel
user-猴子20 小时前
还在手动复制粘贴处理Excel?用AI自动化办公
人工智能·自动化·excel
weixin_3077791321 小时前
Python Pandas读取Excel Sheet生成SQL WHERE条件
python·sql·自动化·excel·pandas
用户298698530141 天前
在 React 中通过 JavaScript 实现 Excel 单元格、行与列的锁定保护
javascript·react.js·excel
用户298698530142 天前
Python 实现 Excel 到 ODS、XPS、PostScript 及 PDF/A-1b 的格式转换
后端·python·excel
本地化文档2 天前
xlwings-docs-l10n
python·github·excel·gitcode·sphinx
用户298698530143 天前
在 React 中拆分 Excel 文件:从工作表到行列的实践
javascript·react.js·excel
不坑老师3 天前
怎么在Word中制作汉字书写笔顺——不坑盒子汉字笔顺步骤在小学低段识字教学中的应用
前端·数据库·人工智能·word·excel·office
不坑老师4 天前
Excel总表如何按班级拆分并分别发送?
前端·数据库·人工智能·excel·ppt·office