比如：有三行数据
年龄 姓名 性别
第一行 1 李四 男
第二行 2 李四 男
第三行 2 张三 男
第四行 3 李四 男
我需要将姓名列为“李四”且性别列为“男”的这三行数据的年龄相加（即为6）合并到第一行，把其他行两行的数据删除。
合并出来的结果应为：
第一行 6 李四 男
第二行 2 张三 男
你这个问题用字典最方便了
sub test ()
dim arr,brr(),x&,i&,d as object,str1$
set d=createojbedt("scripting.dictionary")
arr=range("A1:C"& range("A65536").end(xlup).row)
redim brr(1 to 3,1 to 1)
for x=1 to ubound(arr)
str1=arr(x,2) & "|" & arr(x,3)
if not d.exists(str1) then
i=i+1
d(str1)=i
redim preserve brr(1 to 3,1 to i)
brr(2,i)=arr(x,2)
brr(3,i)=arr(x,3)
end if
brr(1,d(str1))=brr(1,d(str1))+arr(x,1)
next x
range("E1").resize(ubound(brr,2),3)=application.transpose(brr)'你要统计到哪就把前面的单元格地址改成你要写到的地方即可
end sub
sub test ()
dim arr,brr(),x&,i&,d as object,str1$
set d=createojbedt("scripting.dictionary")
arr=range("A1:C"& range("A65536").end(xlup).row)
redim brr(1 to 3,1 to 1)
for x=1 to ubound(arr)
str1=arr(x,2) & "|" & arr(x,3)
if not d.exists(str1) then
i=i+1
d(str1)=i
redim preserve brr(1 to 3,1 to i)
brr(2,i)=arr(x,2)
brr(3,i)=arr(x,3)
end if
brr(1,d(str1))=brr(1,d(str1))+arr(x,1)
next x
range("E1").resize(ubound(brr,2),3)=application.transpose(brr)'你要统计到哪就把前面的单元格地址改成你要写到的地方即可
end sub
温馨提示：答案为网友推荐，仅供参考
第1个回答 2012-12-28
Sub test2_1()
Dim v, i%, j%
v = Split([d1], ",")
j = 0
For i = [a65536].End(xlUp).Row To 1 Step -1
If Cells(i, 2) = v(0) And Cells(i, 3) = v(1) Then
j = j + Cells(i, 1)
Range(Cells(i, 1), Cells(i, 3)).Delete
End If
Next i
Range(Cells(1, 1), Cells(1, 3)).Insert
Cells(1, 1) = j
Cells(1, 2) = v(0)
Cells(1, 3) = v(1)
End Sub
在D1 输入 李四，男 然后运行就可以了
Dim v, i%, j%
v = Split([d1], ",")
j = 0
For i = [a65536].End(xlUp).Row To 1 Step -1
If Cells(i, 2) = v(0) And Cells(i, 3) = v(1) Then
j = j + Cells(i, 1)
Range(Cells(i, 1), Cells(i, 3)).Delete
End If
Next i
Range(Cells(1, 1), Cells(1, 3)).Insert
Cells(1, 1) = j
Cells(1, 2) = v(0)
Cells(1, 3) = v(1)
End Sub
在D1 输入 李四，男 然后运行就可以了
第2个回答 2012-12-28
干嘛用VBA呢？
选择 数据--〉排序，主要关键字选姓名，点确定
之后，数据--〉分类汇总，分类字段还是选择姓名，汇总项目在年龄前打钩
或者数据透视表，就没有自动删除功能了。
选择 数据--〉排序，主要关键字选姓名，点确定
之后，数据--〉分类汇总，分类字段还是选择姓名，汇总项目在年龄前打钩
或者数据透视表，就没有自动删除功能了。
