用嵌套循环求和特定单元格

Question

通常的任务是对Excel数据集中的特定值求和，然后将其粘贴到另一个工作表中。

我的想法是嵌套三个循环。

The first Loop Counts the Project specific number 
   The second Loop Counts the columns (Begins with column 'H')
      The third Loop Counts the rows (Begins with row '9')
         Inside this function the program sums the values related to the project number. 
         After it is done, the accumulated value should be pasted into 
         another worksheet. The cell it has to be pasted in, is the specific cell for 
         the project number and column.
      The third loop ends when it reached the last filled row.
   The second loop ends when it reached the last filled column.
The first loop ends when it reached the last predefined project number

将累积值粘贴到另一个工作表中

Answer 1

Sum and Copy Loop

Adjust the values in the constants section to fit your needs.

The Code

Sub SumAndCopy()

    ' Source
    Const cSheet1 As Variant = "Sheet1"   ' Worksheet Name/Index
    Const cCol1 As Variant = "D"          ' Criteria Column Letter/Number
    Const cValFirst1 As Variant = "H"     ' First Value Column/Number
    Const cFirstRow1 As Integer = 9       ' First Row

    ' Target
    Const cSheet2 As Variant = "Sheet2"   ' Worksheet Name/Index
    Const cCol2 As Variant = "D"          ' Criteria Column Letter/Number
    Const cValFirst2 As Variant = "H"     ' First Value Column/Number
    Const cFirstRow2 As Integer = 9       ' First Row
    ' Both
    Const cValCols As Integer = 6         ' Number of Value Columns

    Dim ws1 As Worksheet      ' Source Worksheet
    Dim ws2 As Worksheet      ' Target Worksheet
    Dim lngLast1 As Long      ' Source Last Used Row
    Dim lngLast2 As Long      ' Target Last Used Row
    Dim intFirst1 As Integer  ' Source First Value Column Number
    Dim intFirst2 As Integer  ' Target First Value Column Number
    Dim i As Long             ' Source Row Counter
    Dim j As Integer          ' Source/Target Value Column Counter
    Dim k As Long             ' Target Row Counter
    Dim lngTemp As Long       ' Value Accumulator

    Set ws1 = Worksheets(cSheet1)
    Set ws2 = Worksheets(cSheet2)

    ' Calculate Last Used Rows.
    lngLast1 = ws1.Cells(ws1.Rows.Count, cCol1).End(xlUp).Row
    lngLast2 = ws2.Cells(ws2.Rows.Count, cCol2).End(xlUp).Row
    ' Calculate First Columns.
    intFirst1 = ws1.Cells(1, cValFirst1).Column
    intFirst2 = ws2.Cells(1, cValFirst2).Column

    ' Loop through cells (rows) of Target Criteria Column.
    For k = cFirstRow2 To lngLast2
        ' Loop through Value Columns.
        For j = 1 To cValCols
            lngTemp = 0 ' Reset Value Accumulator.
            ' Loop through cells (rows) of Source Criteria Column.
            For i = cFirstRow1 To lngLast1
                ' Check if criterias are equal.
                If ws1.Cells(i, cCol1) = ws2.Cells(k, cCol2) Then
                    ' Add value to Val7ue Accumlator
                    lngTemp = lngTemp + ws1.Cells(i, j + intFirst1 - 1)
                End If
            Next
            ' Write accumulated value to current target cell.
            ws2.Cells(k, j + intFirst2 - 1) = lngTemp
        Next
    Next

End Sub