循环遍历第一行,如果Cell Value =“Item Cost”,则遍历该列并在空白处执行小计

时间:2015-01-08 06:53:15

标签: excel vba loops

VBA非常新,但在过去的几周里我们学到了很多东西,并为工作中的项目拼凑了一些代码。

我正在努力解决循环中的循环问题。

基本上我想找到第1行中单元格值为“Item Cost”的每一列,然后循环遍历该列中的每一行,并在空白处放置一个小计。

非常感谢任何有关解决方案的帮助。它是一个更大的项目的一部分,但我正处于这个棘手的问题。

代码: [VBA]

 Sub InsertTotals()


 Dim sh As Worksheet
 Dim rw As Range
 Dim RowCount As Integer

 RowCount = 0

 Set sh = ActiveSheet
 For Each rw In sh.Rows

 If sh.Cells(rw.Row, 1).Value = "Item Cost" Then

    Dim ThisCell As Range
    Dim MySum As Double

    Set ThisCell = rw.offset(-1)

nxt:

Do While ThisCell <> ""
    MySum = MySum + ThisCell
    Set ThisCell = ThisCell.offset(1, 0)
Loop

ThisCell.Value = MySum

If ThisCell.offset(1, 0) <> "" Then
    Set ThisCell = ThisCell.offset(1, 0)
    MySum = 0
    GoTo nxt
End If
End If


Next rw

End Sub

[VBA]

1 个答案:

答案 0 :(得分:0)

我已经改变了收集小计范围的开始和停止的方式。此外,每行在底部都有一个小计,因为那里可能有一个空单元格。

Sub Insert_SubTotals()
    Dim sh As Worksheet
    Dim rw As Long, srw As Long, col As Long

    Set sh = ActiveSheet
    With sh
        For col = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
            If .Cells(1, col) = "Item Cost" Then
                srw = 2
                For rw = 2 To .Cells(Rows.Count, col).End(xlUp).Row + 1
                    If IsEmpty(.Cells(rw, col)) And rw > srw Then
                        '.Cells(rw, col).Value = Application.Sum(.Range(.Cells(srw, col), .Cells(rw - 1, col)))
                        .Cells(rw, col).Formula = "=SUM(" & .Cells(srw, col).Address(0, 0) & _
                                    Chr(58) & .Cells(rw - 1, col).Address(0, 0) & ")"
                        .Cells(rw, col).NumberFormat = _
                          "[color5]_($* #,##0.00_);[color9]_($* (#,##0.00);[color15]_("" - ""_);[color10]_(@_)"
                        srw = rw + 1
                    End If
                Next rw
            End If
        Next col
    End With

    Set sh = Nothing
End Sub

我应用了蓝色会计样式编号格式,以区分小计与其他数字。根据需要修改它。小计保持为=SUM(...)公式。我添加了(并注释了)一行,只是将值保留在公式赋值之上。