对符合条件的文本相加
时间:2011-08-04
来源:互联网
对第一列值相等的单元格对应的第二列单元格文字进行相加,
两列均为文本,非数值,且数据都是自动生成
期待高手回复,谢谢!
已上传附件,请指教!,附:第一列为无序排列,且为批量数据
[ 本帖最后由 左岸麦田 于 2011-8-4 01:51 编辑 ]
文件1.rar(5.56 KB)
两列均为文本,非数值,且数据都是自动生成
期待高手回复,谢谢!
已上传附件,请指教!,附:第一列为无序排列,且为批量数据
[ 本帖最后由 左岸麦田 于 2011-8-4 01:51 编辑 ]
附件

2011-8-4 01:49, 下载次数: 3
作者: 左岸麦田 发布时间: 2011-08-04
复制内容到剪贴板
Dim d As Object, s, n%
Set d = CreateObject("Scripting.Dictionary")
s = Range("f3:g" & [f65536].End(3).Row)
For n = 1 To UBound(s)
If d.exists(s(n, 2)) Then s(n, 1) = "," & s(n, 1)
d(s(n, 2)) = d(s(n, 2)) & s(n, 1)
Next
[i3].Resize(d.Count, 1) = Application.Transpose(d.keys)
[j3].Resize(d.Count, 1) = Application.Transpose(d.items)
Set d = Nothing
End Sub
代码:
Sub by2011()Dim d As Object, s, n%
Set d = CreateObject("Scripting.Dictionary")
s = Range("f3:g" & [f65536].End(3).Row)
For n = 1 To UBound(s)
If d.exists(s(n, 2)) Then s(n, 1) = "," & s(n, 1)
d(s(n, 2)) = d(s(n, 2)) & s(n, 1)
Next
[i3].Resize(d.Count, 1) = Application.Transpose(d.keys)
[j3].Resize(d.Count, 1) = Application.Transpose(d.items)
Set d = Nothing
End Sub
作者: 白云2011 发布时间: 2011-08-04
相关阅读 更多
热门阅读
-
office 2019专业增强版最新2021版激活秘钥/序列号/激活码推荐 附激活工具
阅读:74
-
如何安装mysql8.0
阅读:31
-
Word快速设置标题样式步骤详解
阅读:28
-
20+道必知必会的Vue面试题(附答案解析)
阅读:37
-
HTML如何制作表单
阅读:22
-
百词斩可以改天数吗?当然可以,4个步骤轻松修改天数!
阅读:31
-
ET文件格式和XLS格式文件之间如何转化?
阅读:24
-
react和vue的区别及优缺点是什么
阅读:121
-
支付宝人脸识别如何关闭?
阅读:21
-
腾讯微云怎么修改照片或视频备份路径?
阅读:28