Excel·VBA数组分组问题

看到一个帖子《excel吧-数据分组问题》,对一组数据分成4组,使每组的和值相近
在这里插入图片描述

目录

    • 代码思路
    • 1,分组形式、可分组数
      • 代码1
      • 代码2
      • 代码2举例
    • 2,数组所有分组形式
      • 举例

  • 这个问题可以转化为2步:第1步,获取一组数据的所有分组形式;第2步,对所有分组形式计算其方差,方差最小的则是和值最相近的一组
  • 本文为第1步,获取一组数据的所有分组形式

代码思路

在这里插入图片描述

  • n个元素分成m组,每组元素个数最小值为1,最大值为n-m+1,可以通过组合获取所有分组形式
  • 所有元素进行分组,即组合问题,4组组合数相乘就是一种分组形式的分组数(注意:因为组合不区分顺序,因此当分组内组合的指数为1时,不管底数是多少,分组数都为1)。通过观察上图,可以发现9种元素分成4组,有6种分组形式共18480种分组
  • 有了分组形式和分组数,那就可以获取每种分组形式中的每个分组元素组成
  • 函数调用:以下代码调用了《Excel·VBA数组冒泡排序函数》bubble_sort函数,《Excel·VBA数组组合函数、组合求和》combin_arr1函数(如需使用代码需复制)

1,分组形式、可分组数

有2种代码及结果输出形式,主要使用第2种

代码1

Function 可分组数(ByVal n&, ByVal m&, Optional ByVal mode& = 1)'计算分组成不重复的组数,可选择最终返回组数,和每格内含元素个数的二维数组(从1开始计数)'n元素个数;m需要分成几组;mode为1时返回组数,为2时返回二维数组(组数行*m列)Dim arr, brr, crr, drr, x&, y&, i&, j&, t, tt, a, b, d, s, bb, k, krr, resReDim arr(1 To n - m + 1), brr(1 To n - m + 1)  '组合法计算组数,最大值为n - m + 1x = n - m + 1: arr(1) = 1: brr(1) = m - 1  'arr元素个数,brr重复次数If m = 1 ThenIf mode = 1 Then可分组数 = 1: Exit FunctionElseIf mode = 2 ThenReDim res(1 To 1, 1 To 1): res(1, 1) = n: 可分组数 = res: Exit FunctionEnd IfEnd IfFor i = 2 To x  '每个数字各最多需要的数量arr(i) = i: t = n \ i: tt = n / i  '整除、除,判断是否相等If t = tt And t = m Then  '整除,且正好分配为m组brr(i) = tElseFor j = t To 1 Step -1a = i * j + (m - j)  '数字i有j个,其余为1,判断和是否<=nIf a <= n Then brr(i) = j: Exit ForNextEnd IfNexts = WorksheetFunction.Sum(brr): ReDim crr(1 To s)For i = x To 1 Step -1  '倒序、正序平均分组都在最后For j = 1 To brr(i)y = y + 1: crr(y) = arr(i)  '所有数字按个数写入一个数组NextNext'对数组crr选m个进行组合,获取和值为n,且组合形式唯一的所有组合Dim dict As Object: Set dict = CreateObject("scripting.dictionary"): x = 0drr = combin_arr1(crr, m)  '调用函数返回组合,一维嵌套数组For Each d In drr  '遍历组合,和值等于n;再降序排序,写入字典s = WorksheetFunction.Sum(d)If s = n Then b = bubble_sort(d, "-"): bb = Join(b, "+"): dict(bb) = ""Next'对符合条件的组合形式,计算分成m组的组数,以及每种组合形式的组数For Each k In dict.keyskrr = Split(k, "+"): s = n: y = 1For i = 0 To m - 1   '分组中只有1个元素的无所谓顺序,排除If krr(i) > 1 Then y = y * Application.Combin(s, krr(i)): s = s - krr(i)Nextdict(k) = y: x = x + y    'y每种组合形式的组数,x总组数NextIf mode = 1 Then    '输出结果可分组数 = xElseIf mode = 2 ThenReDim res(1 To x, 1 To m): i = 0For Each k In dict.keyskrr = Split(k, "+")For y = 1 To dict(k)  '重复写入dict(k)行krr数组i = i + 1For j = 0 To m - 1res(i, j + 1) = krr(j)NextNextNext可分组数 = resEnd If
End Function

代码2

Function 可分组数2(ByVal n&, ByVal m&, Optional ByVal mode& = 1)'计算分组成不重复的组数,可选择最终返回总组数,或每种组合形式的组数的二维数组(从1开始计数)'n元素个数;m需要分成几组;mode为1时返回组数,为2时返回二维数组,1列组合形式1列组数Dim arr, brr, crr, drr, x&, y&, i&, j&, t, tt, a, b, d, s, bb, k, resReDim arr(1 To n - m + 1), brr(1 To n - m + 1)  '组合法计算组数,最大值为n - m + 1x = n - m + 1: arr(1) = 1: brr(1) = m - 1  'arr元素个数,brr重复次数If m = 1 Or n = m ThenIf mode = 1 Then可分组数2 = 1ElseIf mode = 2 ThenReDim res(1 To 1, 1 To 2): res(1, 2) = 1res(1, 1) = WorksheetFunction.Rept("1", m): 可分组数2 = resEnd IfExit FunctionEnd IfFor i = 2 To x  '每个数字各最多需要的数量arr(i) = i: t = n \ i: tt = n / i  '整除、除,判断是否相等If t = tt And t = m Then  '整除,且正好分配为m组brr(i) = tElseFor j = t To 1 Step -1a = i * j + (m - j)  '数字i有j个,其余为1,判断和是否<=nIf a <= n Then brr(i) = j: Exit ForNextEnd IfNexts = WorksheetFunction.Sum(brr): ReDim crr(1 To s)For i = x To 1 Step -1  '倒序、正序平均分组都在最后For j = 1 To brr(i)y = y + 1: crr(y) = arr(i)  '所有数字按个数写入一个数组NextNext'对数组crr选m个进行组合,获取和值为n,且组合形式唯一的所有组合Dim dict As Object: Set dict = CreateObject("scripting.dictionary"): x = 0drr = combin_arr1(crr, m)  '调用函数返回组合,一维嵌套数组For Each d In drr  '遍历组合,和值等于n;再降序排序,写入字典s = WorksheetFunction.Sum(d)If s = n Then b = bubble_sort(d, "-"): bb = Join(b, "+"): dict(bb) = ""Next'对符合条件的组合形式,计算分成m组的组数,以及每种组合形式的组数For Each k In dict.keyskrr = Split(k, "+"): s = n: y = 1For i = 0 To m - 1   '分组中只有1个元素的无所谓顺序,排除If krr(i) > 1 Then y = y * Application.Combin(s, krr(i)): s = s - krr(i)Nextdict(k) = y: x = x + y    'y每种组合形式的组数,x总组数NextIf mode = 1 Then    '输出结果可分组数2 = xElseIf mode = 2 ThenReDim res(1 To dict.Count, 1 To 2): i = 0For Each k In dict.keysi = i + 1: res(i, 1) = k: res(i, 2) = dict(k)Next可分组数2 = resEnd If
End Function

代码2举例

Sub 可分组数2举例()arr = 可分组数2(9, 4, 2)If IsArray(arr) Then[a1].Resize(UBound(arr), UBound(arr, 2)) = arrElseDebug.Print arrEnd If
End Sub

在这里插入图片描述
生成的分组形式和分组数都和手工计算一致
代码1的输出结果是上图A列每行按"+"号拆分成4列及重复对应B列数字行数,最终生成结果为18480行*4列

2,数组所有分组形式

  • 为方便后续计算方差,返回结果有分组和值和分组字符串2种形式。可以先调用函数获取和值计算方差及对应的行号,再调用函数获取字符串组成形式,输出行号对应的结果
  • 为减少计算量,last_row参数可以控制是计算所有分组形式,还是仅计算后x行分组形式。因为brr数组越后面元素分布越均匀,当需要计算方差的数组数值之间差异较小时,last_row较小则可以更快计算出结果;而如果数值差异较大的,可以适当增大last_row以便计算正确的结果;last_row等于0时,计算所有分组形式
Function 数组分组(ByVal data_arr, ByVal m&, Optional ByVal mode& = 1, Optional ByVal last_row& = 1)'对数组data_arr分为m组,结果返回二维数组(n行*m列),每列为和值/组成元素(数组从1开始计数)'data_arr元素数组;m需要分成几组;mode为1时返回和值,为2时返回字符串'为减少计算量,因为brr数组越后面元素分布越均匀,故last_row参数仅对brr数组的后last_row行进行分组Dim arr, brr, br, srr, sr, a, n&, i&, j&, x&, y&, r&, rr&, c&, t&, w&, res, trr, temp, s&ReDim arr(1 To 1000)If mode <> 1 And mode <> 2 Then Debug.Print "参数错误": Exit FunctionFor Each a In data_arr  '多行多列的,按列从左往右读取,排除空值If Len(a) Then i = i + 1: arr(i) = aNextn = i: ReDim Preserve arr(1 To n): brr = 可分组数2(n, m, 2)If last_row > 0 And last_row < UBound(brr) Then  'last_row为2即仅计算brr数组后2行;为0则全部计算ReDim br(1 To last_row, 1 To 2)For i = 1 To last_rowbr(i, 1) = brr(i + UBound(brr) - last_row, 1): br(i, 2) = brr(i + UBound(brr) - last_row, 2)Nextbrr = brEnd Ifx = WorksheetFunction.Sum(Application.Index(brr, , 2))ReDim srr(1 To UBound(brr), 1 To m), sr(1 To UBound(brr), 1 To m)For i = 1 To UBound(brr)   'brr第1列转为数组temp = Split(brr(i, 1), "+"): t = brr(i, 2): s = nFor j = 1 To msrr(i, j) = temp(j - 1)NextFor j = 1 To m         '计算重复次数If srr(i, j) > 1 Thent = t \ Application.Combin(s, srr(i, j)): sr(i, j) = t: s = s - srr(i, j)Elsesr(i, j) = 1End IfNextNexti = 1: r = 0: c = 1: rr = 0: ReDim res(1 To x, 1 To m)DoDo While c = 1  '第1列赋值crr = combin_arr1(arr, srr(i, c)): t = sr(i, c)  '重复写入t次For Each a In crrFor j = 1 To tr = r + 1: res(r, c) = aNextNextIf i < UBound(brr) Then i = i + 1 Else Exit DoLoopi = 1: r = 1: rr = 0: c = 2: ReDim temp(1 To n)  '除第1列的其他列,按列赋值Dots = "": y = 0     'trr数组记录剩余元素,temp临时数组For j = 1 To c - 1ts = ts & "++" & Join(res(r, j), "++") & "++"NextFor Each a In arr  '排除前一列已使用元素,且前后+号避免部分重复元素被找到aa = "+" & CStr(a) & "+"If InStr(ts, aa) = 0 Theny = y + 1: temp(y) = aElsets = Replace(ts, aa, "", , 1)End IfNextReDim trr(1 To y)For j = 1 To y     'trr数组更新元素,且转换格式,否则导致求和错误trr(j) = CDbl(temp(j))NextIf c <> m Thencrr = combin_arr1(trr, srr(i, c)): w = 可分组数2(y, m - c + 1)If w = 1 Then  '只赋值第1个,避免c递增后出错res(r, c) = crr(1): rr = rr + 1Elset = sr(i, c): r = r - 1For Each a In crrFor j = 1 To tr = r + 1: res(r, c) = a: rr = rr + 1NextNextEnd IfElseres(r, c) = trr: rr = rr + 1  '最后一列直接赋值,只有1组End Ifr = r + 1  '下一行If rr >= brr(i, 2) Then rr = 0: i = i + 1  'brr一行循环结束,进入下一轮If i > UBound(brr) Then i = 1: r = 1: c = c + 1Loop Until c > mLoop Until r = 1  '所有写入完成后,r=1If mode = 1 Then  '返回结果,求和模式For i = 1 To xFor j = 1 To mres(i, j) = WorksheetFunction.Sum(res(i, j))NextNextElse              '字符串模式For i = 1 To xFor j = 1 To mres(i, j) = Join(res(i, j), "+")NextNextEnd If数组分组 = res
End Function

举例

Sub 数组分组举例()tm = Timerarr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9): a = 数组分组(arr, 4, 1, 0)[a1].Resize(UBound(a), UBound(a, 2)) = aDebug.Print "累计用时" & Format(Timer - tm, "0.00")  '耗时
End Sub

mode参数为1,last_row参数为0,求和模式、输出所有分组形式(以下为部分截图)
在这里插入图片描述
mode参数为2,last_row参数为0,字符串模式、输出所有分组形式(以下为部分截图)
在这里插入图片描述

测试结果9个元素分成4组10个元素分成4组
总分组数1848088110
耗时秒数6.3426.57

本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处:http://www.mzph.cn/news/779520.shtml

如若内容造成侵权/违法违规/事实不符,请联系多彩编程网进行投诉反馈email:809451989@qq.com,一经查实,立即删除!

相关文章

QT 控件有突出感,定义控件边框

QT 控件有突出感&#xff0c;定义控件边框 1.设计师页面 在flat部分选中 这个时候按钮会失去边框如下图&#xff1a; 然后在.cpp文件中写入代码&#xff1a; ui->pushButton->setStyleSheet("border: 1px solid gray;");按钮就有了新的边框&#xff1a;

vant Circle 环形进度条写一个倒计时组件

要点&#xff1a; css旋转让元素平均分布在圆上setInterval函数事件小圆圈和环形进度条跳动的速度一致小程序开发环境 代码&#xff1a; html <van-circlevalue"{{ rate }}"stroke-width"6"color"{{ gradientColor }}"size"400rpx&q…

C++11入门手册第一节,学完直接上手Qt(共两节)

入门 hello.cpp #include <iostream>int main() { std::cout << "Hello Quick Reference\n"<<endl; return 0;} 编译运行 $ g hello.cpp -o hello$ ./hello​Hello Quick Reference 变量 int number 5; // 整数float f 0.95; //…

我不懂,到底找个什么样的工作,女朋友才会满意

烫 金三银四&#xff0c;最近要毕业季&#xff0c;感觉也是tm分手季了。。 又要找工作&#xff0c;又要搞毕业的事情&#xff0c;现在又出来个女朋友的事情 我真的要疯求了&#xff0c;我现在是已经找到了一个大厂&#xff0c;但是是白菜价&#xff0c;base北京&#xff0c;…

快排(六大排序)

快速排序 快速排序是Hoare于1962年提出的一种二叉树结构的交换排序方法&#xff0c;其基本思想为&#xff1a;任取待排序元素序列中的某元素作为基准值&#xff0c;按照该排序码将待排序集合分割成两子序列&#xff0c;左子序列中所有元素均小于基准值&#xff0c;右子序列中所…

vue router.js 传值,根据不同type显示不同内容

vue router.js 传值&#xff0c;根据不同type显示不同内容 el-bread 封装 router.js import Vue from vue import Router from vue-router// 路由前缀 const { prefixBasePath } require(../../config/basePath)// 解决重复点击一个路由报错问题 const originalPush Router…

yolov8本地、autodl环境配置、训练

目录 搭建本地环境安装miniconda3创建一个新的环境安装包 安装pycharm下载汉化导入解释器测试终端终端运行代码 YOLOv8本地训练数据集制作训练文件 YOLOv8 autodl训练流程注册账号充值选则服务器jupyterlab创建训练环境上传文件训练使用vscode SSH使用pycharm专业版SSH下载文件…

最大子序列(蓝桥杯,acwing,单调队列)

题目描述&#xff1a; 输入一个长度为 n 的整数序列&#xff0c;从中找出一段长度不超过 m 的连续子序列&#xff0c;使得子序列中所有数的和最大。 注意&#xff1a; 子序列的长度至少是 1。 输入格式&#xff1a; 第一行输入两个整数 n,m。 第二行输入 n 个数&#xff0…

Matlab|电动汽车充放电V2G模型

目录 1 主要内容 1.1 模型背景 1.2 目标函数 1.3 约束条件 2 部分代码 3 效果图 4 下载链接 1 主要内容 本程序主要建立电动汽车充放电V2G模型&#xff0c;采用粒子群算法&#xff0c;在保证电动汽车用户出行需求的前提下&#xff0c;为了使工作区域电动汽车尽可能多的消…

Mojo与Python——wsl安装mojo

文章目录 前言一、wsl设置二、安装步骤三、mojo初体验四、vscode联合开发总结 前言 此课程为系列课程&#xff0c;借助python语言来学习python语言的超集mojo。可以持续关注。 一、wsl设置 powershell查看wsl的版本&#xff0c;如果版本是1需要修改为2。 二、安装步骤 1.安装m…

浅试Kimi

最近KIMI大模型挺火的&#xff0c;擅长处理中文文本&#xff0c;咱也来试试吧&#xff01; 测试问题&#xff1a; 写一篇800字以上的短片小说&#xff1a;主要故事是以一位上进但其他方面表现平平的大男孩小贱&#xff0c;刚到公司不久&#xff0c;就被一位名叫大弟的女同事看…

HarmonyOS 应用开发之多端协同

多端协同流程 多端协同流程如下图所示。 图1 多端协同流程图 约束限制 由于“多端协同任务管理”能力尚未具备&#xff0c;开发者当前只能通过开发系统应用获取设备列表&#xff0c;不支持三方应用接入。 多端协同需遵循 分布式跨设备组件启动规则。 为了获得最佳体验&…

数据分析之Power BI

POWER QUERY 获取清洗 POWER PIVOT建模分析 如何加载power pivot 文件-选项-加载项-com加载项-转到 POWER VIEW 可视呈现 如何加载power view 文件-选项-自定义功能区-不在功能区中的命令-新建组-power view-添加-确定 POWER MAP可视地图

知识图谱与大数据:区别、联系与应用

目录 前言1 知识图谱1.1 定义1.2 特点1.3 应用 2 大数据2.1 定义2.2 应用 3. 区别与联系3.1 区别3.2 联系 结语 前言 在当今信息爆炸的时代&#xff0c;数据成为了我们生活和工作中不可或缺的资源。知识图谱和大数据是两个关键概念&#xff0c;它们在人工智能、数据科学和信息…

保护电路设计 —(2)过温保护

保护电路设计 —&#xff08;2&#xff09;过温保护 上一讲讲到自锁电路设计&#xff0c;但有的同学还不太清楚怎么去复位这个电路&#xff0c;在这里给出一个例子&#xff0c;去复位这个电路。复位电路也非常简单&#xff0c;使用以下电路即可。如图1所示。 图1:复位电路 为…

HarmonyOS 应用开发之UIAbility组件间交互(设备内)

UIAbility是系统调度的最小单元。在设备内的功能模块之间跳转时&#xff0c;会涉及到启动特定的UIAbility&#xff0c;该UIAbility可以是应用内的其他UIAbility&#xff0c;也可以是其他应用的UIAbility&#xff08;例如启动三方支付UIAbility&#xff09;。 本文将从如下场景…

深入理解指针(7)函数指针变量及函数数组(文章最后放置本文所有原码)

一、函数指针变量 什么是函数指针变量呢&#xff1f; 既然是指针变量&#xff0c;那么它指向的一定是地址&#xff0c;而且我们可以通过地址来调用函数的。 函数是否有地址呢&#xff1f;地址是什么&#xff1f; 经过上面的测试可以看到函数也是有地址的&#xff0c;而且其地…

每日一练 两数相加问题(leetcode)

原题如下&#xff1a; 这道题目是一道链表题&#xff0c;我们对于这种链表类&#xff0c;很显然我们最后输出的是初始节点&#xff0c;所以我们要保留我们的初始头指针&#xff0c;那么我们的第一步一定是把头指针保留一份&#xff0c;然后再让头指针往后进行操作。那么我们进行…

C#热门技术应用:探索.NET Core与ASP.NET Core的前沿

C#热门技术应用&#xff1a;探索.NET Core与ASP.NET Core的前沿 随着信息技术的发展&#xff0c;C#作为微软开发的一款强大的面向对象编程语言&#xff0c;正在越来越多的领域发挥着关键作用。在.NET Core和ASP.NET Core的推动下&#xff0c;C#的发展和应用更是如日中天。今天&…

go中匿名函数的使用

匿名函数的使用 在Go语言中&#xff0c;不能像在Python那样在函数内部以常规方式定义一个具名函数。Go中的函数定义都必须在包级别进行。 不过可以通过匿名函数来实现类似的功能。匿名函数可以在函数内部定义并使用&#xff0c;这使得它们非常适合实现局部辅助函数的功能&…