ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 210|回复: 8

[求助] 有点复杂的数据处理,可能用到去重复和筛选。麻烦大佬了。

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-9-28 12:12 | 显示全部楼层 |阅读模式
每个表格有3000多行数据。平时需要处理多个表,每次手动操作,很麻烦。麻烦大师们了

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-28 12:13 | 显示全部楼层
这个是原始和想要的结果的数据

新建 Microsoft Excel 工作表.zip

56.68 KB, 下载次数: 19

TA的精华主题

TA的得分主题

发表于 2019-9-28 12:35 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-9-28 13:27 来自手机 | 显示全部楼层
VBA小子白的很 发表于 2019-9-28 12:13
这个是原始和想要的结果的数据

能不能问下为啥用这样改变啊?直接查询或筛选开头,相关的信息都有了啊?

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-28 13:37 | 显示全部楼层
zpy2 发表于 2019-9-28 13:27
能不能问下为啥用这样改变啊?直接查询或筛选开头,相关的信息都有了啊?

想制作一个VBA处理,更快,手动操作会比较麻烦。
头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2019-9-28 13:59 | 显示全部楼层
头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2019-9-28 14:00 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-10 18:56 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-10-10 22:43 | 显示全部楼层
  1. Sub 货号()
  2. Dim crr()
  3. Set d = CreateObject("scripting.dictionary")
  4. Set reg = CreateObject("vbscript.regexp")
  5. arr = Sheets("原始数据").UsedRange

  6. With reg
  7.     .Pattern = "(-[A-Z]+)+"
  8.     .Global = True
  9.     For i = 2 To UBound(arr)
  10.         x2 = arr(i, 2)
  11.         If x2 <> "" Then
  12.             ar = .Replace(x2, "")
  13.             ar1 = Right(ar, Len(ar) - InStr(ar, "_"))
  14.             ar2 = Left(ar, InStr(ar, "_") - 1)
  15.             ark = ar1 + ar2
  16.             d(ar) = IIf(d(ar) = "", IIf(.test(x2) = True, "!" & ark & "," & i, ark & "," & i), d(ar) & "," & i)
  17.         End If
  18.     Next
  19. End With

  20. For Each Key In d.keys
  21.     brr = Split(d(Key), ",")
  22.     If InStr(brr(0), "!") = False Then
  23.         n = n + 1
  24.         ReDim Preserve crr(1 To UBound(arr, 2), 1 To n)
  25.         For m = 1 To UBound(crr)
  26.             crr(m, n) = arr(brr(1), m)
  27.         Next
  28.     Else
  29.         n = n + 1
  30.         ReDim Preserve crr(1 To UBound(arr, 2), 1 To n)
  31.         For m = 1 To UBound(crr)
  32.             Select Case m
  33.                 Case 2
  34.                     crr(m, n) = Key
  35.                 Case 8
  36.                     crr(m, n) = Mid(brr(0), 2, Len(brr(0)) - 1)
  37.                 Case 22
  38.                     crr(m, n) = "Parent"
  39.                 Case Else
  40.                     crr(m, n) = arr(brr(1), m)
  41.             End Select
  42.         Next
  43.         For s = 1 To UBound(brr)
  44.             n = n + 1
  45.             ReDim Preserve crr(1 To UBound(arr, 2), 1 To n)
  46.             For m = 1 To UBound(crr)
  47.                 If m = 22 Then
  48.                     crr(m, n) = "Child"
  49.                 Else
  50.                     crr(m, n) = arr(brr(s), m)
  51.                 End If
  52.             Next
  53.         Next
  54.     End If
  55. Next
  56. Sheets("需要的处理后的数据").Activate
  57. Set Rng = Range("A20").Resize(UBound(crr, 2), UBound(crr))
  58. Rng.ClearContents
  59. Rng.Value = Application.Transpose(crr)
  60.    
  61. End Sub
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

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

GMT+8, 2020-4-3 09:49 , Processed in 0.080753 second(s), 15 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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