数据求和问题

cyclelf

举例：一组数据相加能被6整除， ，能不能实现如图所示，算出每组数据相加等于6，按照顺序来组合

taller

taller

1. Sub Demo()
   
2.     Dim iR As Long, arrRes(), iSum
   
3.     Set rngData = Range("A1").CurrentRegion
   
4.     arrData = rngData.Value
   
5.     ReDim arrRes(1 To UBound(arrData, 2), 1 To UBound(arrData, 2))
   
6.     For i = LBound(arrData, 2) To UBound(arrData, 2)
   
7.         iSum = 0
   
8.         For j = i To UBound(arrData, 2)
   
9.             iSum = iSum + arrData(1, j)
   
10.             If iSum >= 6 Then
    
11.                 iR = iR + 1
    
12.                 For k = i To j
    
13.                     arrRes(iR, k) = IIf(arrData(1, k) = 0, "", arrData(1, k))
    
14.                 Next k
    
15.                 i = j
    
16.                 If iSum > 6 Then
    
17.                     arrRes(iR, j) = arrRes(iR, j) - (iSum - 6)
    
18.                     arrData(1, j) = arrData(1, j) - arrRes(iR, j)
    
19.                     i = i - 1
    
20.                 End If
    
21.                 Exit For
    
22.             End If
    
23.         Next j
    
24.     Next i
    
25.     If iR > 0 Then
    
26.         Range("A3").Resize(iR, UBound(arrData, 2)) = arrRes
    
27.     End If
    
28. End Sub

复制代码