设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 将多列有顿号的、有合并单元格的数据进行分行显示。
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 4079|回复: 5

[已解决]将多列有顿号的、有合并单元格的数据进行分行显示。

[复制链接]
发表于 2016-1-18 17:21 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
各位高手：如左边的表格，既有合并单元格的情况，也有几列数据有顿号分开的。
现想得到如下结果：现根据有“、”的数据进行分行，然后将合并单元格的拆分显示。。具体见“目标结果”。。谢谢！

最佳答案
月排行榜 / 总排行榜
雪舞子
2016-1-20 09:35
优化一下：
  1. Sub test1()
  2.     With Sheets("数据源")
  3.         arr = .[a1].CurrentRegion
  4.         ReDim brr(1 To 1000, 1 To UBound(arr, 2))
  5.         For i = 1 To UBound(arr)
  6.             For j = 1 To UBound(arr, 2)
  7.                 If Len(arr(i, j)) = 0 Then
  8.                     arr(i, j) = arr(i - 1, j)
  9.                 End If
  10.             Next
  11.             If InStr(arr(i, 3), "、") Then
  12.                 s = Split(arr(i, 3), "、")
  13.                 For m = 0 To UBound(s)
  14.                     n = n + 1
  15.                     For j = 1 To UBound(arr, 2)
  16.                         If InStr(arr(i, j), "、") Then
  17.                             brr(n, j) = Split(arr(i, j), "、")(m)
  18.                         Else
  19.                             brr(n, j) = arr(i, j)
  20.                         End If
  21.                     Next
  22.                 Next
  23.             Else
  24.                 n = n + 1
  25.                 For j = 1 To UBound(arr, 2)
  26.                     brr(n, j) = arr(i, j)
  27.                 Next
  28.             End If
  29.         Next
  30.     End With
  31.     With Sheets("sheet1")
  32.         .UsedRange.ClearContents
  33.         .[a1].Resize(n, UBound(arr, 2)) = brr
  34.     End With
  35. End Sub
复制代码

将多列有顿号的、有合并单元格的数据进行分行显示。。.zip

22 Bytes, 下载次数: 3
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
 楼主| 发表于 2016-1-18 17:40 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
附件可能有点问题。。再次上传。。谢谢！

将多列有顿号的、有合并单元格的数据进行分行显示。。.zip

8.52 KB, 下载次数: 6
回复

使用道具 举报

 楼主| 发表于 2016-1-19 17:31 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
在工作的过程中，发现有个新问题：就是有多列的数据有顿号要分行。。现将新附件上传，希望得到你们的解答！

（新上传）将多列有顿号的、有合并单元格的数据进行分行显示。。.zip

10.03 KB, 下载次数: 2
回复

使用道具 举报

发表于 2016-1-19 18:13 | 显示全部楼层
原代码基础上做下改动，楼主测试一下：
  1. Sub test()
  2.     On Error Resume Next
  3.     a = Array(1, 2, 4, 5, 6, 8)
  4.     With Sheets("数据源")
  5.         arr = .[a1].CurrentRegion
  6.         ReDim brr(1 To 1000, 1 To UBound(arr, 2))
  7.         For i = 1 To UBound(arr)
  8.             For j = 1 To UBound(arr, 2)
  9.                 If Len(arr(i, j)) = 0 Then
  10.                     arr(i, j) = arr(i - 1, j)
  11.                 End If
  12.             Next
  13.             If InStr(arr(i, 3), "、") Then
  14.                 s = Split(arr(i, 3), "、")
  15.                 For m = 0 To UBound(s)
  16.                     n = n + 1
  17.                     For x = 0 To UBound(a)
  18.                         brr(n, a(x)) = arr(i, a(x))
  19.                     Next
  20.                     brr(n, 3) = s(m)
  21.                     brr(n, 5) = Split(arr(i, 5), "、")(m)
  22.                     brr(n, 6) = Split(arr(i, 6), "、")(m)
  23.                     brr(n, 7) = Split(arr(i, 7), "、")(m)
  24.                 Next
  25.             Else
  26.                 n = n + 1
  27.                 For j = 1 To UBound(arr, 2)
  28.                     brr(n, j) = arr(i, j)
  29.                 Next
  30.             End If
  31.         Next
  32.     End With
  33.     With Sheets("sheet1")
  34.         .UsedRange.ClearContents
  35.         .[a1].Resize(n, UBound(arr, 2)) = brr
  36.     End With
  37. End Sub
复制代码
将多列有顿号的、有合并单元格的数据进行分行显示。。.rar (11.04 KB, 下载次数: 14)

评分

参与人数 1 +1 收起 理由
amzxfgh9632 + 1 很给力

查看全部评分

回复

使用道具 举报

发表于 2016-1-20 09:35 | 显示全部楼层    本楼为最佳答案   
优化一下：
  1. Sub test1()
  2.     With Sheets("数据源")
  3.         arr = .[a1].CurrentRegion
  4.         ReDim brr(1 To 1000, 1 To UBound(arr, 2))
  5.         For i = 1 To UBound(arr)
  6.             For j = 1 To UBound(arr, 2)
  7.                 If Len(arr(i, j)) = 0 Then
  8.                     arr(i, j) = arr(i - 1, j)
  9.                 End If
  10.             Next
  11.             If InStr(arr(i, 3), "、") Then
  12.                 s = Split(arr(i, 3), "、")
  13.                 For m = 0 To UBound(s)
  14.                     n = n + 1
  15.                     For j = 1 To UBound(arr, 2)
  16.                         If InStr(arr(i, j), "、") Then
  17.                             brr(n, j) = Split(arr(i, j), "、")(m)
  18.                         Else
  19.                             brr(n, j) = arr(i, j)
  20.                         End If
  21.                     Next
  22.                 Next
  23.             Else
  24.                 n = n + 1
  25.                 For j = 1 To UBound(arr, 2)
  26.                     brr(n, j) = arr(i, j)
  27.                 Next
  28.             End If
  29.         Next
  30.     End With
  31.     With Sheets("sheet1")
  32.         .UsedRange.ClearContents
  33.         .[a1].Resize(n, UBound(arr, 2)) = brr
  34.     End With
  35. End Sub
复制代码

评分

参与人数 2 +4 收起 理由
kangkangtianxia + 3 很给力
amzxfgh9632 + 1 很给力

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-1-20 15:22 | 显示全部楼层
雪舞子 发表于 2016-1-20 09:35
优化一下：

谢谢帮助！谢谢！
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-5-19 03:39 , Processed in 0.308385 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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