o2o家电维修网站开发公司图标设计logo

当前位置： 首页 > news >正文

o2o家电维修网站开发,公司图标设计logo,广元市网站建设,网站页面排版看到一个帖子《excel吧-数据分组问题》#xff0c;对一组数据分成4组#xff0c;使每组的和值相近 目录 代码思路1#xff0c;分组形式、可分组数代码1代码2代码2举例 2#xff0c;数组所有分组形式举例 这个问题可以转化为2步#xff1a;第1步#xff0c;获取一组数据…看到一个帖子《excel吧-数据分组问题》对一组数据分成4组使每组的和值相近 目录 代码思路1分组形式、可分组数代码1代码2代码2举例 2数组所有分组形式举例 这个问题可以转化为2步第1步获取一组数据的所有分组形式第2步对所有分组形式计算其方差方差最小的则是和值最相近的一组本文为第1步获取一组数据的所有分组形式 代码思路 n个元素分成m组每组元素个数最小值为1最大值为n-m1可以通过组合获取所有分组形式所有元素进行分组即组合问题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, sReDim 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 所有写入完成后r1If 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 Submode参数为1last_row参数为0求和模式、输出所有分组形式以下为部分截图 mode参数为2last_row参数为0字符串模式、输出所有分组形式以下为部分截图
测试结果9个元素分成4组10个元素分成4组总分组数1848088110耗时秒数6.3426.57