Question

excel中如何合并相同行，数量相加。

各位大侠，您好！看一下小弟上传的图片教一下怎么做。网上看不清楚，点击图片放大，再图片上右点击，然后图片另存为，保存到桌面，再查看图片才看得清楚。

Answer 1

1、使用excel将我们的表格文件打开，然后选择人名并单击鼠标右键在右键菜单哪里找到复制选项，如图所示。

2、点击复制之后再选择单元格，并单击鼠标右键找到粘贴选项，粘贴之后再在数据里找到删除重复项选项。

3、点击删除重复项之后我们在后面的的单元格内输入求和函数。

4、在求和函数的括号内输入我们的参数。

5、输入好参数之后按下回车键我们就得到了计算的结果了。

6、选择计算的结果将鼠标放到右下角然后向下拖动我们就将所有的结果都计算出来了。

Answer 2

合并内容相同的行常见的三种方法：
一、用数据透视表，最简单方便。如下：
点击数据－数据透视表及数据透视图－完成，把第一列的字段名拉到“行字段”，把第二列的字段名拉到“数据”即可。
二、可以使用分类汇总，步骤如下：
1、数据－排序，按代号、名称排序，这样相同的代号名称就会排在一起；
2、数据－分类汇总－汇总字段：代号，汇总方式：求和，求和字段：数量。
三、高级筛选
点击数据－－筛选－－高级筛选－－列表区域就是你的数据区域，选中“选择不重复的记录”－－确定即可(此法适应于计数，不能累计) 。

Answer 3

选中一行的数据，复制，再选下一行，选择性粘贴----数值-----加-----OK

追问

你好，看一下我上传的图片，用什么方法做不用一个一个来算。

追答

为什么不用分类汇总来做呢？应该很方便的
数据----分类汇总

Answer 4

只能使用宏。 因为需要判断你指定的范围内那些行是相同的，这个excel的函数也能做到，但要分解成几步做还要来回copy-paste。

追问

你好，看一下我上传的图片，用什么方法做不用一个一个来算。

追答

OK, 晚上试着给你做一个

追问

嗯。

追答

' 先把做好的宏放到工作表的sheet上去，方法：
'【工具】→【宏】→ Visual Basic 编辑器
' 打开后找到《Microsoft Excel 对象》下面的"Sheet1 (你对该sheet的命名)"
' 复制以下的内容到编辑器的页面上去
'【工具】→【宏】→ ，找到'Sheet1.合并相加相同行", 选择后点"执行"
' 一切OK, 不需要你自己做任何运算，且瞬间完成
' ps 这里把宏设成了模块，所以不一定非要搁到sheet1去，搁哪个sheet都行
' 测试通过。如遇到问题，再追问。

'---------------------------------------------------------------------
Sub 合并相加相同行()

'------------------------------------
Dim R1 As Integer, NumDelRows As Integer
Application.CutCopyMode = False
'------------------------------------ 测定表包含的行数→R1
With ActiveSheet '把表复制到下面去
R1 = .Cells(30000, 1).End(xlUp).Row
Range(.Rows(1), .Rows(R1)).Select
Selection.Copy: .Cells(R1 + 4, 1).Select
End With
ActiveSheet.Paste
'------------------------------------
With Selection
i = 2: NumDelRows = 0 '合并的行数
While i 6 Then If .Cells(i1, j) .Cells(i, j) _
Then 相同 = False: Exit For
Next
If 相同 Then
' StatusBar = "合并了第 " & i & " 行与第 " & i1 & " 行"
.Cells(i, 6) = .Cells(i, 6) + .Cells(i1, 6)
.Rows(i1).Delete
R1 = R1 - 1: NumDelRows = NumDelRows + 1
Else: i1 = i1 + 1
' StatusBar = "第 " & i & " 行与第 " & i1 & " 行不相同"
End If
Wend: i = i + 1
Wend: MsgBox "共计合并了 " & NumDelRows & " 行"
End With
End Sub

追问

还有一个问题，没有编码的行都不见了，能不能没有编码的不执行任何操作。

追答

可能是忘记说明了：

1。 宏的执行范围只限于你当前看到的画面。想做哪个表格，这个表就必须在你眼前(ie 程序文本中的activesheet)之内，然后再执行宏，否则出错。

2。表的下方，最后的一行以下不可以存在任何数据，否则出错。

3。稍改了一下，以下这个能自动判别表格的范围。这样上面第2条的限制就没有。就是说，现在把表放在sheet的哪一行（现在是第1行）开始都没关系，但必须固定在 A列 到 I列之间、且数字列在F列。改过之后反而更为简洁了。

Sub 合并相同行()
'------------------------------------
Application.CutCopyMode = False
With ActiveSheet '自动测定表的范围
i = 0: Do: i = i + 1: Loop Until .Cells(i, 1) "" Or i > 10000
If i > 10000 Then MsgBox "表呢？": Exit Sub
j = i: Do: j = j + 1: Loop Until .Cells(j, 1) = "" Or j > 40000
If j > 40000 Then MsgBox "表超过了4万行": Exit Sub
Range(.Rows(i), .Rows(j - 1)).Copy
.Cells(j + 3, 1).Select: .Paste '把表复制到下面去
End With
With Selection: R1 = .Rows.Count '表包含的行数
i = 2: NumDelRows = 0 '合并的行数
While i 6 Then If .Cells(i1, j) .Cells(i, j) Then 相同 = False: Exit For
Next
If 相同 Then
.Cells(i, 6) = .Cells(i, 6) + .Cells(i1, 6)
.Rows(i1).Delete: NumDelRows = NumDelRows + 1
R1 = R1 - 1
Else: i1 = i1 + 1: End If
Wend: i = i + 1
Wend: MsgBox "共计合并了 " & NumDelRows & " 行"
End With
'------------------------------------
End Sub

Answer 5

1.建议使用分类汇总，但是相关信息显示需要使用乘积项显示，数量需要求和项，就是当中需要自己做一点步骤才能显示成你所需要的
2. vba解决，但是思路跟分类汇总过程近似

追问

你好，看一下我上传的图片，用什么方法做不用一个一个来算。

追答

一步完成的话，还是宏吧，右击任意sheet，查看代码，新建一个模块，复制如下代码
因为我不知道你的sheet的名称，所以假设你的数据是在sheet1，
宏会新建一个sheet将分类好得数据放在里面，你试一下吧
Sub sum_device()
Worksheets(1).Select
Sheets.Add
Sheet1.Cells.Copy (Worksheets(1).Cells)
Worksheets(1).Select
Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 1)).Select
If WorksheetFunction.CountBlank(Selection) > 0 Then
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
End If
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range(Cells(1, 1), ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
k = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To k
If Cells(i, 1) = "" Then
Exit For
ElseIf Cells(i, 1) = Cells(i + 1, 1) Then
Cells(i + 1, 6) = Cells(i, 6) + Cells(i + 1, 6)
Rows(i).Delete SHIFT:=xlUp
End If
Next i
Cells(1, 1).Select
End Sub