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

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 数据按要求重新排列
数据透视表40+个常用小技巧，让你一次学会！
12下一页
返回列表 发新帖
查看: 4813|回复: 14

[已解决]数据按要求重新排列

[复制链接]
HNZZHGY
发表于 2016-3-21 11:59 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
数据按要求重新排列
最佳答案
月排行榜 / 总排行榜
dsmch
2016-3-21 13:35
原数据模拟有误，与效果不符
  1. Sub Macro1()
  2. Dim arr, brr, d, i&, j%
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Range("a1").CurrentRegion
  5. ReDim brr(1 To UBound(arr) - 1, 1 To 1)
  6. For i = 2 To UBound(arr)
  7.     d(arr(i, 1)) = d(arr(i, 1)) & "," & i
  8. Next
  9. For i = 2 To UBound(arr)
  10.     sj = arr(i, 1)
  11.     If sj <> "" And d.exists(sj) Then
  12.         x = Split(Mid(d(sj), 2), ",")
  13.         For j = 0 To UBound(x)
  14.             s = s + 1
  15.             brr(s, 1) = sj
  16.             arr(x(j), 1) = ""
  17.         Next
  18.         ljf = IIf(Len(sj) = 6, "", "-")
  19.         zf = Right(sj, 3) & ljf & Left(sj, 3)
  20.         If d.exists(zf) Then
  21.             y = Split(Mid(d(zf), 2), ",")
  22.             For j = 0 To UBound(y)
  23.                 s = s + 1
  24.                 brr(s, 1) = zf
  25.                 arr(y(j), 1) = ""
  26.             Next
  27.         End If
  28.     End If
  29. Next
  30. Range("d2").Resize(UBound(brr)) = brr
  31. End Sub
复制代码

数据排序.zip

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

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
sry660
发表于 2016-3-21 12:13 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
楼主的排序依据是什么呢？这个需要说明一下
回复

使用道具 举报

HNZZHGY
 楼主| 发表于 2016-3-21 12:31 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
sry660 发表于 2016-3-21 12:13
楼主的排序依据是什么呢？这个需要说明一下

单元格中数字不论顺序，字符一样的排在一起，我在用颜色表示相同的！
回复

使用道具 举报

dsmch
发表于 2016-3-21 12:31 | 显示全部楼层
  1. Sub Macro1()
  2. Dim arr, brr, d, i&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Range("a1").CurrentRegion
  5. ReDim brr(1 To UBound(arr) - 1, 1 To 1)
  6. For i = 2 To UBound(arr)
  7.     d(arr(i, 1)) = i
  8. Next
  9. For i = 2 To UBound(arr)
  10.     sj = arr(i, 1)
  11.     If sj <> "" And d.exists(sj) Then
  12.         s = s + 1
  13.         brr(s, 1) = sj
  14.         ljf = IIf(Len(sj) = 6, "", "-")
  15.         zf = Right(sj, 3) & ljf & Left(sj, 3)
  16.         If d.exists(zf) Then s = s + 1: brr(s, 1) = zf: arr(d(zf), 1) = ""
  17.     End If
  18. Next
  19. Range("d2").Resize(UBound(brr)) = brr
  20. End Sub
复制代码

数据排序.zip

15.45 KB, 下载次数: 3
回复

使用道具 举报

HNZZHGY
 楼主| 发表于 2016-3-21 12:35 | 显示全部楼层
本帖最后由 HNZZHGY 于 2016-3-21 12:46 编辑
dsmch 发表于 2016-3-21 12:31

再请教一下，如果有三个或更多相同时如何解决？

数据排序2.zip

13.97 KB, 下载次数: 4
回复

使用道具 举报

dsmch
发表于 2016-3-21 13:35 | 显示全部楼层    本楼为最佳答案   
原数据模拟有误，与效果不符
  1. Sub Macro1()
  2. Dim arr, brr, d, i&, j%
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Range("a1").CurrentRegion
  5. ReDim brr(1 To UBound(arr) - 1, 1 To 1)
  6. For i = 2 To UBound(arr)
  7.     d(arr(i, 1)) = d(arr(i, 1)) & "," & i
  8. Next
  9. For i = 2 To UBound(arr)
  10.     sj = arr(i, 1)
  11.     If sj <> "" And d.exists(sj) Then
  12.         x = Split(Mid(d(sj), 2), ",")
  13.         For j = 0 To UBound(x)
  14.             s = s + 1
  15.             brr(s, 1) = sj
  16.             arr(x(j), 1) = ""
  17.         Next
  18.         ljf = IIf(Len(sj) = 6, "", "-")
  19.         zf = Right(sj, 3) & ljf & Left(sj, 3)
  20.         If d.exists(zf) Then
  21.             y = Split(Mid(d(zf), 2), ",")
  22.             For j = 0 To UBound(y)
  23.                 s = s + 1
  24.                 brr(s, 1) = zf
  25.                 arr(y(j), 1) = ""
  26.             Next
  27.         End If
  28.     End If
  29. Next
  30. Range("d2").Resize(UBound(brr)) = brr
  31. End Sub
复制代码
回复

使用道具 举报

HNZZHGY
 楼主| 发表于 2016-3-21 13:42 | 显示全部楼层
达到了要求，谢谢老师！
回复

使用道具 举报

HNZZHGY
 楼主| 发表于 2016-3-21 14:21 | 显示全部楼层
dsmch 发表于 2016-3-21 13:35
原数据模拟有误，与效果不符

老师我再问一下如果原始数据起始在不同的行列，比如在单元格K11起始时如何修改？

点评

dsmch
修改第4句，arr=[k11:k200]  发表于 2016-3-21 18:58
回复

使用道具 举报

HNZZHGY
 楼主| 发表于 2016-3-21 16:00 | 显示全部楼层
本帖最后由 HNZZHGY 于 2016-3-21 16:09 编辑
HNZZHGY 发表于 2016-3-21 14:21
老师我再问一下如果原始数据起始在不同的行列，比如在单元格K11起始时如何修改？

为什么都是所有数据的第一列，空行后一列，而不是我想那列就那列，如果这样如何修改？
回复

使用道具 举报

HNZZHGY
 楼主| 发表于 2016-3-21 19:36 | 显示全部楼层
HNZZHGY 发表于 2016-3-21 16:00
为什么都是所有数据的第一列，空行后一列，而不是我想那列就那列，如果这样如何修改？

修改后只能达到平移效果，达不到排列效果！！
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-4-27 09:33 , Processed in 0.588588 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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