VBA 区间内每列数值累加居中

On_fire

VBA 区间内每列数值累加居中

*

Sheet1是源数据, 1~8行是标题行,

O~Y列是要处理的列范围, 每个区间行数是变量 ( 第9行往下, 红线与红线之间 )

( 注:没参加计算的数据暂时删去 )

*

代码的逻辑如下,

1.      累加O~X每列, 区间内的值, 再各自合并居中

2.      累加Y列, 区间内的值,再除二 ( =:/2 ) , 再合并居中

*

模拟部分结果在Sheet1(2)

*

恳请大神, 老师出手帮忙...谢谢!

On_fire

推一推…...

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&, p&, k&, iSum&, iTarNum&, iTarget&, isFlag As Boolean
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Intersect(Columns("O:Y"), Rows("9:" & Rows.Count)).Resize(1000)
        ar = .Value: p = 1
        For i = 1 To UBound(ar)
            If .Cells(i, 1).Borders(xlEdgeBottom).Color = 255 Then
                With Range(.Cells(p, 1), .Cells(i, 1)).Resize(, UBound(ar, 2))
                    br = .Value
                    For j = 1 To UBound(br, 2)
                        iSum = 0: isFlag = False
                        For k = 1 To UBound(br)
                            If CBool(br(k, j)) And isFlag = False Then
                               iTarget = k
                               isFlag = True
                            End If
                            iSum = iSum + br(k, j)
                        Next k
                        If CBool(iSum) Then
                            .Cells(iTarget, j) = IIf(j = UBound(br, 2), iSum / 2, iSum)
                        End If
                        With .Cells(1, j).Resize(UBound(br))
                            .Merge
                            .HorizontalAlignment = xlCenter
                        End With
                    Next j
                End With
                p = i + 1
             End If
         Next i
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Beep
End Sub

gwjkkkkk

请参考附件。。。