ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 499|回复: 17

[求助] 合并与拆分

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-8-18 07:46 | 显示全部楼层 |阅读模式
工作簿1.rar (8.96 KB, 下载次数: 14) 屏幕捕获_2024_08_18_07_42_35_167.png

TA的精华主题

TA的得分主题

发表于 2024-8-18 07:49 | 显示全部楼层
十年老司机了,不会写VBA吗  有点不可思议。。。。

TA的精华主题

TA的得分主题

发表于 2024-8-18 08:34 | 显示全部楼层
简单问题。

工作簿1.rar

33.38 KB, 下载次数: 21

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2024-8-18 08:40 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-8-18 08:44 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2024-8-18 08:44 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
这个用textsplit、textjoint方便咯
=TEXTSPLIT(A2,",")

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-8-18 08:45 | 显示全部楼层
本帖最后由 jx928867128 于 2024-8-18 10:20 编辑

感谢老师的多次帮忙,学会了用的方法了,再次谢谢

TA的精华主题

TA的得分主题

发表于 2024-8-18 09:39 | 显示全部楼层
拆分汇总二合一
  1. Sub 分分合合()
  2.     Dim arr, brr, brrTmp
  3.     Dim myrow%, myrowB%, mycolB%
  4.     myrowA = Range("A" & Rows.Count).End(xlUp).Row
  5.     myrowB = Range("B" & Rows.Count).End(xlUp).Row
  6.     If myrowA > myrowB Then myrow = myrowA Else myrow = myrowB
  7.    
  8.     arr = Range("A1:A" & myrowA).Value
  9.     For i = 2 To myrow
  10.         If Range("A" & i) <> "" And _
  11.            Range("B" & i) = "" Then         '如果A有B无
  12.             brr = Split(arr(i, 1), ",")
  13.             Range("B" & i). _
  14.                 Resize(1, UBound(brr) + 1).Value = brr
  15.         End If
  16.         
  17.         If Range("A" & i) = "" And _
  18.            Range("B" & i) <> "" Then        '如果A无B有
  19.             mycolB = Range("B" & i).End(xlToRight).Column - 1
  20.             brr = Range("B" & i).Resize(1, mycolB).Value
  21.             brrTmp = Application.Transpose(Application.Transpose(brr))  '二维转一维
  22.             Range("A" & i).Value = Join(brrTmp, ",")
  23.         End If
  24.     Next
  25. End Sub

复制代码
分分合合.png

分分合合.rar

17.14 KB, 下载次数: 9

TA的精华主题

TA的得分主题

发表于 2024-8-18 10:42 | 显示全部楼层
  1. Sub 分分合合()
  2.     Dim arr, brr, brrTmp
  3.     Dim myrow%, myrowB%, mycolB%
  4.     myrowA = Range("A" & Rows.Count).End(xlUp).Row
  5.     myrowB = Range("B" & Rows.Count).End(xlUp).Row
  6.     If myrowA > myrowB Then myrow = myrowA Else myrow = myrowB
  7.    
  8.     arr = Range("A1:A" & myrowA).Value
  9.     For i = 2 To myrow
  10.         If Range("A" & i) <> "" And _
  11.            Range("B" & i) = "" Then         '如果A有B无
  12.             brr = Split(arr(i, 1), ",")
  13.             Range("B" & i). _
  14.                 Resize(1, UBound(brr) + 1).Value = brr
  15.         End If
  16.         
  17.         If Range("A" & i) = "" And _
  18.            Range("B" & i) <> "" Then        '如果A无B有
  19.             mycolB = Range("B" & i).End(xlToRight).Column - 1
  20.             brr = Range("B" & i).Resize(1, mycolB).Value
  21.             brrTmp = Application.Transpose(Application.Transpose(brr))  '二维转一维
  22.             Range("A" & i).Value = Join(brrTmp, ",")
  23.         End If
  24.     Next
  25. End Sub

复制代码

TA的精华主题

TA的得分主题

发表于 2024-8-18 10:46 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-18 14:33 , Processed in 0.043846 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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