2015-01-08 43 views
-1

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]

+0

對於像這樣的簡單任務,此代碼對我來說顯得非常低效。你基本上遍歷整個工作表兩次。執行一次運行需要多長時間?通過使用SUBTOTAL()工作表函數,您可能可以在不使用VBA的情況下實現目標 – silentsurfer

回答

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(...)公式。我已經添加(並評論)了一條只會將公式賦值上方的值。