循环中的excel vba和捕获单元格值需要求和

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 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

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