excel vba总结循环和捕获单元格值需要总和

我有两个有数据的工作表的Excel。 第一个工作表被称为每月，并有一个人的名单，费用金额和费用date。 这是在费用转入时input的。在第二张工作表上，我尝试复制第一张工作表中的数据，然后按照人员进行sorting。 在每个人之间插入两个空白行，然后为每个人添加一个小计。 我已经想出了如何做前三个步骤。 （可能不是最好的方法，但它的工作原理）我可以使用一些帮助，如何获得我创build的第一个空白行中的第二个工作表上的每个人的总和。 当它试图确定在哪里放置空行时，我可能也会出现循环错误。

谢谢

这是每月工作表的屏幕截图
以下是YTD工作表的屏幕截图

Private Sub CommandButton1_Click() 'create variable for max row count of E Dim rowcount As Double Dim rowcount2 As Double 'Max row count of E to use in copy rowcount = Sheets("Monthly").Range("E" & Rows.Count).End(xlUp).Row 'Select Data Copy data Sheets("Monthly").Range("A5:E" & rowcount).Copy Destination:=Sheets("YTD `Total").Range("A5")` rowcount2 = Sheets("YTD Total").Range("E" & Rows.Count).End(xlUp).Row 'Sort Rows by Employee in YTD Dim onerange As Range Dim acell As Range Set onerange = Sheets("YTD Total").Range("A5:E" & rowcount2) Set acell = Sheets("YTD Total").Range("A5") onerange.Sort Key1:=acell, Order1:=xlAscending 'insert blank rows between Employee Dim emp1 As String Dim emp2 As String Dim count1 As Double Dim count2 As Double Dim rowcount3 As Double Dim counter As Double Dim currentcell As String Dim sum1 As Double Dim sum2 As Double rowcount3 = Sheets("YTD Total").Range("A" & Rows.Count).End(xlUp).Row count1 = "5" count2 = "6" For Each Cell In Sheets("YTD Total").Range("A5:A12") '" & rowcount3) emp1 = Sheets("YTD Total").Range("A" & count1) emp2 = Sheets("YTD Total").Range("A" & count2) If emp1 = emp2 Then count1 = count1 + 1 count2 = count2 + 1 ' ElseIf emp1 <> emp2 And emp1 = Null Then ' count1 = count1 + 1 ' count2 = count2 + 1 ' ElseIf emp1 = Null And emp2 = Null Then ' count1 = count1 + 1 ' count2 = count2 + 1 Else Range("A" & count2).EntireRow.Insert Range("A" & count2).EntireRow.Insert currentcell = Cell.Address Range("C" & (count2)) = sum1 count1 = count1 + 3 count2 = count2 + 3 End If Next Cell End Sub Private Sub CommandButton2_Click() Dim Answer As String Dim MyNote As String 'Place your text here MyNote = "Are you sure you want to Delete content? Please be aware if no data in A5 you will delete your headers" 'Display MessageBox Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "???") If Answer = vbNo Then 'Code for No button Press MsgBox "You pressed NO!" Else Lastrow = Sheets("YTD Total").Range("E" & Rows.Count).End(xlUp).Row Range("A5", "E" & Lastrow).ClearContents End If End Sub 

这里有一些数据复制到Excel中

 AAA 12345-001 1.40 Expense AAA 12345-002 0.25 Expense BBB 67819-001 1.25 Expense AAA 67819-002 5.00 Expense AAA 11111-001 5.85 Expense BBB 11111-001 0.05 Expense CCC 22222-002 0.95 Expense CCC 22222-003 5.00 Expense DDD 12345-001 1.30 Expense BBB 11111-001 0.25 Expense DDD 12345-001 5.40 Expense AAA 22222-003 7.70 Expense BBB 22222-001 5.75 Expense 

Answer 1

总之，我添加了以下variables：

 Dim rcount1 As Long Dim rcount2 As Long Dim rng as Range 

然后我只是改变你的for循环到这个：

 For Each Cell In Sheets("YTD Total").Range("A5:A12") emp1 = Sheets("Monthly").Range("A" & count1) emp2 = Sheets("Monthly").Range("A" & count2) If emp1 = emp2 Then count1 = count1 + 1 count2 = count2 + 1 rcount1 = rcount1 + 1 rcount2 = rcount2 + 1 Else Range("A" & count2).EntireRow.Insert Range("A" & count2).EntireRow.Insert currentcell = Cell.Address Set rng = Range("C" & (count2 - 1) & ":C" & Range("C" & (count2) - 1).End(xlUp).Row) Range("C" & (count2)).Formula = "=SUM(" & rng.Address(flase, flase) & ")" count1 = count1 + 3 count2 = count2 + 3 count1 = count1 + 1 count2 = count2 + 1 End If Next Cell 

希望这至less能让你指出正确的方向！