求大神帮忙将原始数据按照城市对应的金额进行排列组合求和计算

chinasun0

将原始数据按照城市对应的金额进行排列组合求和计算

计算规则：

1. 根据原始数据的城市和金额，进行排列组合计算得到结果数据
2. 结果数据显示由哪个或哪几个原始数据金额进行的排列组合，并对这组排列组合的原始金额进行求和计算

多谢大神帮助

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, vResult, i&, j&, r&, dic As Object, vKey
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    ReDim vResult(1 To 10 ^ 5, 1 To 3)
   
    ar = Range("B4", Cells(Rows.Count, "C").End(xlUp)).Value
    For i = 1 To UBound(ar)
        dic(ar(i, 1)) = dic(ar(i, 1)) & " " & ar(i, 2)
    Next i
   
    ar = Split("城市 金额排列组合 排列组合后金额求和")
    r = 1
    For i = 0 To UBound(ar)
        vResult(r, i + 1) = ar(i)
    Next i
   
    For Each vKey In dic.keys
        ar = Split(dic(vKey))
        For j = UBound(ar) To 1 Step -1
            br = combinArr1(ar, j)
            For i = 1 To UBound(br)
                r = r + 1
                vResult(r, 1) = vKey
                vResult(r, 2) = br(i)
                vResult(r, 3) = Evaluate(br(i))
            Next i
        Next j
    Next
   
    With [J3].Resize(r, UBound(vResult, 2))
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .EntireColumn.AutoFit
        .Value = vResult
    End With
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

Function combinArr1(ByVal ar, ByVal n&)
    Dim br&(), cr, vResult, i&, j&, m&, iCount&, iGroup&, vTemp

    m = UBound(ar)
    iGroup = Application.Combin(m, n)
    ReDim vResult(1 To iGroup)
    ReDim br&(1 To n)
    ReDim cr(1 To n)
    If n = 1 Then
        For i = 1 To iGroup
            cr(1) = ar(i)
            vResult(i) = Join(cr, "+")
        Next i
        combinArr1 = vResult
        Exit Function
    End If
    For j = 1 To n - 1: br(j) = j: Next
   
    Do
        For i = br(n - 1) + 1 To m
            br(n) = i
            iCount = iCount + 1
            For j = 1 To n
                cr(j) = ar(br(j))
            Next j
            vResult(iCount) = Join(cr, "+")
        Next
        If br(n - 1) < br(n) - 1 Then
            br(n - 1) = br(n - 1) + 1
        Else
            For j = n - 2 To 1 Step -1
                If br(j) <> br(j + 1) - 1 Then
                    vTemp = br(j) + 1: br(j) = vTemp: j = j + 1
                    Do Until j = n
                        br(j) = br(j - 1) + 1: j = j + 1
                    Loop
                    Exit For
                End If
            Next
        End If
    Loop Until iCount = iGroup
    combinArr1 = vResult
End Function

gwjkkkkk

请参考附件。。。

LIUZHU

参与下，JSA代码

1. function 排列组合(){
   
2.         let arr=Range("b2").CurrentRegion.Value2.slice(2);
   
3.         let obj=arr.reduce((dic,[a,b])=>((dic[a]=dic[a] || []).push(b),dic),{});
   
4.         let res=[["城市","排列组合","求和"]];
   
5.         for (let key in obj){
   
6.                 let temp=obj[key];
   
7.                 temp.forEach((x,i)=>{
   
8.                         let pzarr=plzh(temp,"组合",temp.length-i);
   
9.                         pzarr.forEach(y=>res.push([key,y.join("+"),eval(y.join("+"))]));
   
10.                 });
    
11.         }
    
12.         Range("n3").Resize(res.length,res[0].length).Value2=res;
    
13. }
    
14. 
    
15. function plzh(szarr,type,m){
    
16.         let arr=[],temp=[],len=szarr.length;
    
17.         let getplzh=(k)=>{
    
18.                 szarr.forEach((x,i)=>{
    
19.                         if (i<k || temp.includes(x)) return;
    
20.                         temp.push(x);
    
21.                         if (temp.length==m){
    
22.                                 arr.push([...temp]);
    
23.                                 temp.splice(temp.length-1);                //去掉尾部
    
24.                                 return;
    
25.                         }
    
26.                         getplzh(type=="组合"?i+1:0);
    
27.                 });
    
28.                 temp.splice(temp.length-1);                                //去掉尾部
    
29.         }
    
30.         getplzh(0);
    
31.         return arr;
    
32. }

复制代码

LIUZHU

WPS软件测试有效

chinasun0

gwjkkkkk 发表于 2024-3-27 19:02
请参考附件。。。

多谢帮助，感谢

chinasun0

LIUZHU 发表于 2024-3-28 01:08
WPS软件测试有效

多些帮助，万分感谢