Question

我想对每个名称的E列中的数字求和，并将结果放在F列中。我的意思是：

（Sheet 1中）

     colA-Name:   colE-Number:       
row1: Michael          16         
row2: Michael          20         
row3: Andrew           15         
row4: Edward           19         
row5: Edward           13         
row6: Edward           24         
row7: Helen            17

我想要这样的事情：

     colA-Name:   colF-SUM:       
row1: Michael          36         
row2: Michael                    
row3: Andrew           15         
row4: Edward           56         
row5: Edward                       
row6: Edward                   
row7: Helen            17

到目前为止，这是我的代码，但不起作用。

    Sub sum()
    Dim Rng As Range
    Dim cel As Range
    Dim lastRowA As Long
    Dim myRange As Range
    Dim myString As String

    lastRowA = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Sheets("Sheet1").Range("A2:A" & lastRowA)
    Set cel = Sheets("Sheet1").Range("A:A")

    'find duplicates name in column A
    Set myRange = Sheets("Sheet1").Range("A2:A" & lastRowA).Find(What:=myString, LookAt:=xlPart)

    For Each cel In Rng
        'if founded, sum their numbers and put it in F column    
        If Not myRange Is Nothing Then
             cel.Offset(0, 5) = cel.Offset(0, 4).Value + cel.Offset(1, 4).Value 
            'Range("F:F").Value = cel.Offset(0, 4).Value + cel.Offset(1, 4).Value
        End If
    Next
    End Sub

有人能帮忙吗？谢谢！

Answer 1

如果可能适合

，您可以使用简单的excel公式

=IF(ISERROR(VLOOKUP(ACurRow;A$1:A(CurRow-1);1;FALSE));SUMIF(A$1:A$LastRow;ACurRow;E$1:E$LastRow);"")

在任何行的预期结果列中输入公式 - 第一行除外。这是我称之为“CurRow”的行
将“CurRow”和“LastRow”引用替换为公式
将公式粘贴到所有其他行

Answer 2

我解决了这个问题。我改变了方式，但却是我想要的。以下代码：

从A列中找到重复的名称
复制F列中的每个名称
计算与每个名称匹配的数字的总和。
我在G栏中得到了结果。

代码：

    Sub sum()
    Dim cell As Range
    Dim ws As Worksheet
    Dim rngA As Range
    Dim myString As String
    Dim i As Integer
    Dim Found As Boolean

    Set ws = Sheets("Sheet1")
    ws.Select
    lastrRowA = ws.Range("A" & Rows.Count).End(xlUp).Row
    ws.Range("F2:G" & lastrRowA).Clear
    Set rngA = ws.Range("A2:A" & lastrRowA)

    'find duplicates in column A and copy once in column F
    For Each cell In rngA
        myString = cell.Value
        i = 2
        Found = False
        While ws.Cells(i, 6).Value <> "" And Not Found
            If ws.Cells(i, 6).Value = myString Then
                Found = True
            End If
            i = i + 1
        Wend
        If Not Found Then
            ws.Cells(i, 6).Value = myString
        End If
    Next

    'ascending column F
    ws.Select
        ws.Range("F2:F" & lastrRowA).Select
        Selection.sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortTextAsNumbers
            ws.Range("A1").Select

 'sum the numbers(from column E) for each Name (i.e. Michael=16+20=36 etc.) and put the results in col G
    For RRF = 1 To ws.Range("F" & Rows.Count).End(xlUp).Row
    NT = ws.Range("F" & RRF).Value
        For RR1 = 1 To lastrRowA
        If NT = ws.Range("A" & RR1).Value Then ws.Range("G" & RRF).Value = ws.Range("G" & RRF).Value + ws.Range("E" & RR1).Value
        Next RR1
    Next RRF

    End Sub

将特定细胞与条件相加 - vba

2 个答案: