Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2505|回复: 4

[已解决]VBA 数组问题

[复制链接]
发表于 2017-8-30 12:17 | 显示全部楼层 |阅读模式
请教大神,“计算”表中B列的数值与“数据”表中C列的数值是对应关系,想把“计算”表中B列的数组转换成“数据”表中G列和J列的集合,值存在“计算”表中C列和D列,VBA应该怎么写?如表中第一行另,外“计算”表B列的数组中有一部分值,在“数据”表中是没有的,不参与计算,求助大神指点!!万分感谢!

最佳答案
2017-8-30 12:47
  1. Sub aaa()
  2. Dim arr, brr, crr, i&, j&, rng As Range
  3. arr = Sheets(2).Range("b1:b" & Sheets(2).[b65536].End(3).Row)
  4. ReDim brr(1 To UBound(arr), 1 To 2)
  5. For i = 1 To UBound(arr)
  6.   crr = Split(arr(i, 1), "-")
  7.   For j = 0 To UBound(crr)
  8.     Set rng = Sheets(1).Columns(3).Find(crr(j), lookat:=xlWhole)
  9.     If Not rng Is Nothing Then
  10.       brr(i, 1) = brr(i, 1) & rng.Offset(, 4)
  11.       brr(i, 2) = brr(i, 2) & rng.Offset(, 7)
  12.     End If
  13.   Next j
  14. Next i
  15. Sheets(2).[c1].Resize(UBound(brr), 2) = brr
  16. End Sub
复制代码

数据.zip

13.98 KB, 下载次数: 4

发表于 2017-8-30 12:47 | 显示全部楼层    本楼为最佳答案   
  1. Sub aaa()
  2. Dim arr, brr, crr, i&, j&, rng As Range
  3. arr = Sheets(2).Range("b1:b" & Sheets(2).[b65536].End(3).Row)
  4. ReDim brr(1 To UBound(arr), 1 To 2)
  5. For i = 1 To UBound(arr)
  6.   crr = Split(arr(i, 1), "-")
  7.   For j = 0 To UBound(crr)
  8.     Set rng = Sheets(1).Columns(3).Find(crr(j), lookat:=xlWhole)
  9.     If Not rng Is Nothing Then
  10.       brr(i, 1) = brr(i, 1) & rng.Offset(, 4)
  11.       brr(i, 2) = brr(i, 2) & rng.Offset(, 7)
  12.     End If
  13.   Next j
  14. Next i
  15. Sheets(2).[c1].Resize(UBound(brr), 2) = brr
  16. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2017-8-30 13:59 | 显示全部楼层

谢谢大神帮助,已验证没问题,但有个问题,当我数据量很大时候,比如有几万条数据,运行效率还能提高吗?
回复

使用道具 举报

发表于 2017-8-30 14:49 | 显示全部楼层
把数据表中的数据装入数组,再用字典检索的话可能会比较快,但要视情况而定:
1、源数据多,而计算表中数据少,这种情况下用现在的代码比较快;
2、源数据多,计算表中数据也多,这种情况下将源数据装入数组+字典比较快;
3、源数据少,计算表中数据多,这种情况下将源数据装入数组+字典也比较快。
实际上单元格操作是速度较慢的,但考虑到将大量数据装入数组+字典也需要耗费时间,所以不一定所有情况下数组+字典都有优势。
回复

使用道具 举报

 楼主| 发表于 2017-8-30 16:13 | 显示全部楼层
大灰狼1976 发表于 2017-8-30 14:49
把数据表中的数据装入数组,再用字典检索的话可能会比较快,但要视情况而定:
1、源数据多,而计算表中数 ...

长知识了,谢谢!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 04:24 , Processed in 0.694225 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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