excel vba sum循环并捕获单元格值需要求和

Question

我有一个excel有两个有数据的工作表。 第一个工作表称为每月工作表，其中包含人员列表和费用金额以及费用日期。 在输入费用时输入。在第二个工作表上，我试图从第一个工作表中复制数据，然后按人员排序。 在每个人之间插入两行空白，然后对每个人进行小计。 我已经弄清楚如何做前3个步骤。 （可能不是最好的方法，但是它可以工作）我可以使用一些帮助，以获取如何在我创建的第一个空白行中的第二个工作表上获得每个人的总和。 在尝试确定将空行放入何处时，我可能还会出现循环错误。

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

以下是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

总之，我添加了以下变量：

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

然后我只是将你的for循环更改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

希望这至少能为您指明正确的方向！