Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1805|回复: 7

[已解决]求大神帮忙在这个宏里面加个逗号就好

[复制链接]
发表于 2017-8-19 09:18 | 显示全部楼层 |阅读模式
就是这个表格差不多已经做好了的,现在我想就是把合并的单元格的内容,每个内容中间加个逗号,效果就是
科目等级
数学A,E,K
谢谢了。
最佳答案
2017-8-19 09:47
  1. Sub 分类合并()
  2.     Application.Calculation = xlCalculationManual       '手动重算
  3.     '清除区域
  4.     Range("e3:e65536") = ""
  5.     '筛选姓名
  6.     Range("A2:A65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
  7.         "D2"), Unique:=True
  8.     '合并内容
  9.     For a = 3 To [a65536].End(xlUp).Row
  10.         b = [d65536].End(xlUp).Row
  11.         c = Range("d3:d" & b).Find(Range("a" & a).Value).Row      '在指定区域查找指定文本返回行号
  12.         If Range("e" & c) <> "" Then
  13.             Range("e" & c) = Range("e" & c).Value & "," & Range("b" & a).Value
  14.         Else
  15.             Range("e" & c) = Range("e" & c).Value & Range("b" & a).Value
  16.         End If
  17.     Next
  18.     Application.Calculation = xlCalculationAutomatic    '自动重算
  19. End Sub
复制代码


仅仅在你的代码上修改了下
你的这个个人觉得用字典也挺好的

合并字符.rar

38.99 KB, 下载次数: 9

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2017-8-19 09:27 | 显示全部楼层
回复

使用道具 举报

发表于 2017-8-19 09:44 | 显示全部楼层
模块1不是已有代码了么,
e2=aa($A$3:$A$14,$B$3:$B$14,D3,",")
回复

使用道具 举报

发表于 2017-8-19 09:47 | 显示全部楼层    本楼为最佳答案   
  1. Sub 分类合并()
  2.     Application.Calculation = xlCalculationManual       '手动重算
  3.     '清除区域
  4.     Range("e3:e65536") = ""
  5.     '筛选姓名
  6.     Range("A2:A65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
  7.         "D2"), Unique:=True
  8.     '合并内容
  9.     For a = 3 To [a65536].End(xlUp).Row
  10.         b = [d65536].End(xlUp).Row
  11.         c = Range("d3:d" & b).Find(Range("a" & a).Value).Row      '在指定区域查找指定文本返回行号
  12.         If Range("e" & c) <> "" Then
  13.             Range("e" & c) = Range("e" & c).Value & "," & Range("b" & a).Value
  14.         Else
  15.             Range("e" & c) = Range("e" & c).Value & Range("b" & a).Value
  16.         End If
  17.     Next
  18.     Application.Calculation = xlCalculationAutomatic    '自动重算
  19. End Sub
复制代码


仅仅在你的代码上修改了下
你的这个个人觉得用字典也挺好的
回复

使用道具 举报

 楼主| 发表于 2017-8-19 09:48 | 显示全部楼层
怎么加进去,小白不会加
回复

使用道具 举报

发表于 2017-8-19 09:49 | 显示全部楼层
本帖最后由 idnoidno 于 2017-8-19 09:51 编辑
  1. Sub t1()
  2. Dim ar, br, i%, d As Object
  3. Set d = CreateObject("scripting.dictionary")
  4. ar = Range("a3:b" & Cells(Rows.Count, 1).End(xlUp).Row)
  5. For i = 1 To UBound(ar)
  6.     d(ar(i, 1)) = d(ar(i, 1)) + ar(i, 2) & ","
  7. Next i
  8. [d14].Resize(d.Count) = Application.Transpose(d.keys)
  9. [e14].Resize(d.Count) = Application.Transpose(d.items)
  10. Set d = Nothing
  11. End Sub
复制代码


不反對用字典方式給您吧
回复

使用道具 举报

发表于 2017-8-19 09:57 | 显示全部楼层
dearmysxj 发表于 2017-8-19 09:48
怎么加进去,小白不会加

给你加进去了

合并字符.zip

40.23 KB, 下载次数: 3

回复

使用道具 举报

 楼主| 发表于 2017-8-19 09:58 | 显示全部楼层
已解决,谢谢4楼
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 22:03 , Processed in 3.047110 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表