设为首页收藏本站
简字体切换切换到宽版

ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步，快速开始

快捷登录

搜索
ExcelHome技术论坛»论坛 › Excel 技术交流与问答 › Excel VBA程序开发 › 电子表格中如果同一列中同时出现两种分隔符号，怎么同时 ...
EH技术汇-专业的职场技能充电站 妙哉！函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器，一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理，一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
返回列表 发新帖
查看: 3606|回复: 8

[求助] 电子表格中如果同一列中同时出现两种分隔符号，怎么同时变成多行？

[复制链接]
awaichufeng

TA的精华主题

TA的得分主题
发表于 2013-9-29 17:40 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
电子表格中如果同一列中同时出现两种分隔符号，怎么同时变成多行？求救各位大佬帮帮小弟！谢谢！！

如：分裂前：
序号
A
B
C
D
1
大
35/35/35
20/100/180
2009/9/9
2
小
40/40/40
45/150/300
2011/11/11
3
中
35\35\35
20\100\180
2009\9\9
4
无
40\40\40
45\150\300
2011\11\11
变成：
序号
A
B
C
D
1
大
35
20
2009
2
大
35
100
9
3
大
35
180
9
4
小
40
45
2011
5
小
40
150
11
6
小
40
300
11
7
中
35
20
2009
8
中
35
100
9
9
中
35
180
9
10
无
40
45
2011
11
无
40
150
11
12
无
40
300
11


数据.rar (11.46 KB, 下载次数: 13)
电子, 电子表格, 表格, 如果, 同一
回复

举报

zhaogang1960

TA的精华主题

TA的得分主题
发表于 2013-9-29 18:49 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
请测试：
  1. Sub 宏1()
  2.     Dim arr, brr(1 To 100000, 1 To 5), i&, j&, m&, a, b, c
  3.     arr = Range("A1").CurrentRegion
  4.     For i = 2 To UBound(arr)
  5.         For j = 3 To 4
  6.             arr(i, j) = Replace(arr(i, j), "", "/")
  7.         Next
  8.         arr(i, 5) = Replace(arr(i, 5), "", "-")
  9.         If InStr(arr(i, 3), "/") > 0 And InStr(arr(i, 4), "/") > 0 Then
  10.             a = Split(arr(i, 3), "/")
  11.             b = Split(arr(i, 4), "/")
  12.             c = Split(arr(i, 5), "-")
  13.             For j = 0 To 2
  14.                 m = m + 1
  15.                 brr(m, 1) = m
  16.                 brr(m, 2) = arr(i, 2)
  17.                 brr(m, 3) = a(j)
  18.                 brr(m, 4) = b(j)
  19.                 brr(m, 5) = c(j)
  20.             Next
  21.         End If
  22.     Next
  23.     If m > 0 Then [a2].Resize(m, 5) = brr
  24. End Sub
复制代码
回复

举报

zhaogang1960

TA的精华主题

TA的得分主题
发表于 2013-9-29 18:50 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
请看附件
数据.rar (23.73 KB, 下载次数: 22)

评分

1

查看全部评分

回复

举报

awaichufeng

TA的精华主题

TA的得分主题
 楼主| 发表于 2013-9-29 22:41 | 显示全部楼层
[广告] ★Excel Home云课堂 - 专业的职场技能充电站★         ★Excel三大利器★        ★ 笨办法学VBA全系列★
首先感谢上楼的老大，小弟在此谢谢！！

现在如果有个单元格式两个，其他单元格是三个，分成多行后，少数字那行数据为空格，，那怎么设计程序较好？？？
                                
     
序号
A
B
C
D
1
大
35/35/35
20/100/180
2009/9/9
2
小
40/40/40
45/150/300
2011/11/11
3
中
35\35\35
20\100
2009\9\9
4
无
40\40\40
45\150\
2011\11\11
变成：
序号
A
B
C
D
1
大
35
20
2009
2
大
35
100
9
3
大
35
180
9
4
小
40
45
2011
5
小
40
150
11
6
小
40
300
11
7
中
35
20
2009
8
中
35
100
9
9
中
35
　
9
10
无
40
45
2011
11
无
40
150
11
12
无
40
　
11
                           
                                
回复

举报

zhaogang1960

TA的精华主题

TA的得分主题
发表于 2013-9-29 23:13 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
awaichufeng 发表于 2013-9-29 22:41
首先感谢上楼的老大，小弟在此谢谢！！

现在如果有个单元格式两个，其他单元格是三个，分成多行后，少数 ...
  1. Sub 宏1()
  2.     Dim arr, brr(1 To 100000, 1 To 5), i&, j&, m&, l&, a, b, c
  3.     arr = Range("A1").CurrentRegion
  4.     On Error Resume Next
  5.     For i = 2 To UBound(arr)
  6.         For j = 3 To 4
  7.             arr(i, j) = Replace(arr(i, j), "", "/")
  8.         Next
  9.         arr(i, 5) = Replace(arr(i, 5), "", "-")
  10.         If InStr(arr(i, 3), "/") > 0 And InStr(arr(i, 4), "/") > 0 Then
  11.             a = Split(arr(i, 3), "/")
  12.             b = Split(arr(i, 4), "/")
  13.             c = Split(arr(i, 5), "-")
  14.             l = IIf(UBound(a) > UBound(b), UBound(a), UBound(b))
  15.             For j = 0 To l
  16.                 m = m + 1
  17.                 brr(m, 1) = m
  18.                 brr(m, 2) = arr(i, 2)
  19.                 brr(m, 3) = a(j)
  20.                 brr(m, 4) = b(j)
  21.                 brr(m, 5) = c(j)
  22.             Next
  23.         End If
  24.     Next
  25.     If m > 0 Then [a2].Resize(m, 5) = brr
  26. End Sub
复制代码
回复

举报

zhaogang1960

TA的精华主题

TA的得分主题
发表于 2013-9-29 23:15 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
请看附件
数据.rar (23.2 KB, 下载次数: 23)
回复

举报

awaichufeng

TA的精华主题

TA的得分主题
 楼主| 发表于 2013-9-30 09:04 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
zhaogang1960 发表于 2013-9-29 23:13

运行后的结果有错误！！
回复

举报

zhaogang1960

TA的精华主题

TA的得分主题
发表于 2013-9-30 17:29 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
awaichufeng 发表于 2013-9-30 09:04
运行后的结果有错误！！

是最后一列日期格式不正确，修改一下：
  1. Sub 宏1()
  2.     Dim arr, brr(1 To 100000, 1 To 5), i&, j&, m&, l&, a, b, c
  3.     arr = Range("A1").CurrentRegion
  4.     On Error Resume Next
  5.     For i = 2 To UBound(arr)
  6.         For j = 3 To 4
  7.             arr(i, j) = Replace(arr(i, j), "", "/")
  8.         Next
  9.         arr(i, 5) = Replace(arr(i, 5), "", "-")
  10.         If InStr(arr(i, 3), "/") > 0 And InStr(arr(i, 4), "/") > 0 Then
  11.             a = Split(arr(i, 3), "/")
  12.             b = Split(arr(i, 4), "/")
  13.             c = Split(arr(i, 5), "-")
  14.             l = IIf(UBound(a) > UBound(b), UBound(a), UBound(b))
  15.             For j = 0 To l
  16.                 m = m + 1
  17.                 brr(m, 1) = m
  18.                 brr(m, 2) = arr(i, 2)
  19.                 brr(m, 3) = a(j)
  20.                 brr(m, 4) = b(j)
  21.                 brr(m, 5) = c(j)
  22.             Next
  23.         End If
  24.     Next
  25.     If m > 0 Then
  26.         Range("A1").CurrentRegion.Offset(1).Clear
  27.         [a2].Resize(m, 5) = brr
  28.     End If
  29. End Sub
复制代码

评分

1

查看全部评分

回复

举报

LMY123

TA的精华主题

TA的得分主题
发表于 2018-7-25 09:53 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
a = Split(arr(i, 3), "/")
回复

举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2025-1-10 20:30 , Processed in 0.028546 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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