将多次出现的值汇总到一行中

Question

我有一张纸：

我正在尝试编写代码以便能够将多个值组合成一行，我需要对列B，C和D中的值求和。

我的目标是能够按下按钮并删除所有重复值，但在此之前，相邻列中的数值将汇总到单个版本中。

到目前为止，我已从列中删除了重复项：

Sheets("Sheet4").Select
With Columns("A:A")
.Replace What:="mobile", Replacement:=""
End With

Answer 1

以前的代码应该可以胜任。它可能需要微调，但想法会起作用。不要忘记为您的范围正确处理工作表。我没做这个。这将在当前的活动工作表上有效。

更新：已更新工作表地址。

Dim ws As Worksheet
Dim LastRow As Long
Dim S_Value As String

Set ws = Sheets("Sheet1")
LastRow = Range("A" & Rows.Count).End(xlUp).Row

i = 2
While i <= LastRow

    S_Value = ws.Range("A" & i).Value
    j = i + 1
        While j <= LastRow
            If ws.Range("A" & j).Value = S_Value Then
                ws.Range("B" & i).Value = ws.Range("B" & i).Value + ws.Range("B" & j).Value
                ws.Range("C" & i).Value = ws.Range("C" & i).Value + ws.Range("C" & j).Value
                ws.Range("D" & i).Value = ws.Range("D" & i).Value + ws.Range("D" & j).Value
                ws.Rows(j & ":" & j).EntireRow.Delete
                LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
                j = j - 1
            End If
            j = j + 1
        Wend
i = i + 1
Wend

Answer 2

你走了，

Sub SumCount()
    Dim s, c, sm
    Dim Rws As Long, Rng As Range
    Rws = Cells(Rows.Count, "B").End(xlUp).Row
    Set Rng = Range(Cells(2, 2), Cells(Rws, 4))
    s = InputBox("What Number to Find?")
    c = Application.WorksheetFunction.CountIf(Rng, s)
    sm = s * c
    MsgBox sm

End Sub