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

相关推荐
蹦蹦跳跳垂耳兔3 分钟前
Excel创建组妙用隐藏
excel
开开心心_Every2 小时前
无广告干扰:简单好用文字LOGO设计工具
xml·java·网络·数据库·华为od·华为云·excel
CodeCraft Studio1 天前
Excel处理控件Aspose.Cells教程:使用C#在Excel中创建气泡图
信息可视化·c#·excel·aspose·excel api库·excel气泡图·excel组件库
CodeCraft Studio1 天前
国产化Excel开发组件Spire.XLS教程:使用Python批量删除Excel分页符
开发语言·python·excel·python开发·spire.xls·excel api库·excel开发组件
缺点内向1 天前
C#:轻松实现Excel到TXT的转换
后端·c#·.net·excel
ghgxm5201 天前
EXCEL使用VBA代码实现按条件查询数据库--简单实用
开发语言·数据仓库·笔记·excel·数据库开发
kaka-3332 天前
微信小程序中使用 xlsx(xlsx.mini.min.js)实现 Excel 导入导出功能
javascript·微信小程序·excel
开开心心_Every2 天前
优化C盘存储:自定义软件文档保存路径工具
java·网络·数据库·typescript·word·asp.net·excel
狮子也疯狂2 天前
【天翼AI-星辰智能体平台】| 基于Excel表实现智能问数助手智能体开发实战
人工智能·oracle·excel
梦幻通灵3 天前
Excel序列生成的4种方案实战
excel