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

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 一个复杂的提取和分例
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 1762|回复: 5

[已解决]一个复杂的提取和分例

[复制链接]
WL001
发表于 2016-3-25 07:21 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 WL001 于 2016-3-25 08:28 编辑

高手些，这是小弟经常用要用手工处理的一份表，人都累倒了！希望高手些能帮助一下哦！详见附件。
最佳答案
月排行榜 / 总排行榜
蓝桥玄霜
2016-3-26 18:28
  1. Sub lqxs()
  2. Dim Arr, i&, Brr, xs, aa, bb, cc, gg, j&
  3. Sheet3.Activate
  4. [a2:ab5000].ClearContents
  5. Arr = Sheet2.[a1].CurrentRegion
  6. ReDim Brr(1 To UBound(Arr) - 1, 1 To 28)
  7. For i = 2 To UBound(Arr)
  8.     Brr(i - 1, 1) = Arr(i, 1): Brr(i - 1, 2) = Arr(i, 2)
  9.     xs = Arr(i, 3)
  10.     aa = Split(xs, "*")(1)
  11.     bb = Split(xs, "#"): Brr(i - 1, 7) = bb(1): Brr(i - 1, 4) = bb(1)
  12.     If InStr(bb(0), "阿迪") Or InStr(bb(0), "Ad") Then
  13.         Brr(i - 1, 3) = "AD": Brr(i - 1, 8) = "阿迪达斯"
  14.     ElseIf InStr(bb(0), "耐克") Or InStr(bb(0), "Ni") Or InStr(bb(0), "NIKE") Then
  15.         Brr(i - 1, 3) = "NK": Brr(i - 1, 8) = "耐克"
  16.     ElseIf InStr(bb(0), "Pu") Then
  17.         Brr(i - 1, 3) = "PM": Brr(i - 1, 8) = "Puma"
  18.     End If
  19.     Brr(i - 1, 9) = xs: gg = Arr(i, 4): Brr(i - 1, 6) = gg
  20.     cc = Split(gg, "/")(1)
  21.     If Brr(i - 1, 8) = "阿迪达斯" Then
  22.         If InStr(cc, ".") Then
  23.             Brr(i - 1, 5) = Split(cc, ".")(0) & "-"
  24.         Else
  25.             Brr(i - 1, 5) = cc
  26.         End If
  27.     Else
  28.         Brr(i - 1, 5) = cc
  29.     End If
  30.     For j = 5 To UBound(Arr, 2)
  31.         Brr(i - 1, j + 5) = Arr(i, j)
  32.     Next
  33. Next
  34. [a2].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
  35. End Sub
复制代码

求助.rar

21.18 KB, 下载次数: 25
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
发表于 2016-3-25 08:07 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
最好直接有条理的说明要如何处理数据，你的两个表有许多列，我大致看了一下，两个表只是列的顺序不同，想细看，觉得头是昏的，因我还要像猜谜一样，来估计两表的差别。
回复

使用道具 举报

发表于 2016-3-25 09:55 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上

分割.rar

30.22 KB, 下载次数: 6
回复

使用道具 举报

baksy
发表于 2016-3-25 10:16 | 显示全部楼层
公式

求助.zip

25.57 KB, 下载次数: 6
回复

使用道具 举报

WL001
 楼主| 发表于 2016-3-25 20:08 | 显示全部楼层
baksy 发表于 2016-3-25 10:16
公式

谢谢！能否用VBA来实现呢？？
回复

使用道具 举报

发表于 2016-3-26 18:28 | 显示全部楼层    本楼为最佳答案   
  1. Sub lqxs()
  2. Dim Arr, i&, Brr, xs, aa, bb, cc, gg, j&
  3. Sheet3.Activate
  4. [a2:ab5000].ClearContents
  5. Arr = Sheet2.[a1].CurrentRegion
  6. ReDim Brr(1 To UBound(Arr) - 1, 1 To 28)
  7. For i = 2 To UBound(Arr)
  8.     Brr(i - 1, 1) = Arr(i, 1): Brr(i - 1, 2) = Arr(i, 2)
  9.     xs = Arr(i, 3)
  10.     aa = Split(xs, "*")(1)
  11.     bb = Split(xs, "#"): Brr(i - 1, 7) = bb(1): Brr(i - 1, 4) = bb(1)
  12.     If InStr(bb(0), "阿迪") Or InStr(bb(0), "Ad") Then
  13.         Brr(i - 1, 3) = "AD": Brr(i - 1, 8) = "阿迪达斯"
  14.     ElseIf InStr(bb(0), "耐克") Or InStr(bb(0), "Ni") Or InStr(bb(0), "NIKE") Then
  15.         Brr(i - 1, 3) = "NK": Brr(i - 1, 8) = "耐克"
  16.     ElseIf InStr(bb(0), "Pu") Then
  17.         Brr(i - 1, 3) = "PM": Brr(i - 1, 8) = "Puma"
  18.     End If
  19.     Brr(i - 1, 9) = xs: gg = Arr(i, 4): Brr(i - 1, 6) = gg
  20.     cc = Split(gg, "/")(1)
  21.     If Brr(i - 1, 8) = "阿迪达斯" Then
  22.         If InStr(cc, ".") Then
  23.             Brr(i - 1, 5) = Split(cc, ".")(0) & "-"
  24.         Else
  25.             Brr(i - 1, 5) = cc
  26.         End If
  27.     Else
  28.         Brr(i - 1, 5) = cc
  29.     End If
  30.     For j = 5 To UBound(Arr, 2)
  31.         Brr(i - 1, j + 5) = Arr(i, j)
  32.     Next
  33. Next
  34. [a2].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
  35. End Sub
复制代码

求助0326.rar

31.47 KB, 下载次数: 20
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-5-8 03:49 , Processed in 0.244265 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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