Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

数据透视表40+个常用小技巧,让你一次学会!
查看: 799|回复: 3

[已解决]将excel表中的数组公式用VBA编程实现

[复制链接]
发表于 2022-4-16 15:54 | 显示全部楼层 |阅读模式
3学分
本帖最后由 protel2003 于 2022-4-16 16:14 编辑


请高手用VBA编程的方式,将B列数据自动填充到对应的行上,A列重复几次,就填几个行单元格。1、在VBA中使用excel中公式数组的形式编一下;2、用其他VBA编程的方式再搞一个附件是数据表
谢谢

最佳答案
2022-4-16 15:54
  1. Sub 宏2()
  2. Dim source As Range
  3. Dim dic As Object, arr, brr
  4. Set dic = CreateObject("Scripting.Dictionary")
  5. Set source = Range("a2").CurrentRegion
  6. Set source = Range("a2").Resize(source.Rows.Count - 1, 2)


  7. For i = 1 To source.Rows.Count
  8. With source(i, 1)
  9. If Not dic.exists(.Text) Then
  10.     ReDim arr(1 To source.Rows.Count + 1)
  11.     arr(1) = 1
  12.     arr(2) = .Offset(0, 1).Text
  13.     dic.Add .Text, arr
  14.    
  15. Else
  16.     brr = dic(.Text)
  17.     brr(1) = brr(1) + 1
  18.     brr(brr(1) + 1) = .Offset(0, 1).Text
  19.     dic(.Text) = brr
  20. End If
  21. End With
  22. Next

  23. ReDim arr(1 To source.Rows.Count, 1 To source.Rows.Count)
  24. For i = 1 To source.Rows.Count
  25. t = dic(source(i, 1).Text)
  26. For j = 1 To t(1)
  27. arr(i, j) = t(1 + j)
  28. Next
  29. Next
  30. [C2].Resize(source.Rows.Count, source.Rows.Count) = arr
  31. End Sub
复制代码

数据表.zip

383.55 KB, 下载次数: 12

最佳答案

发表于 2022-4-16 15:54 | 显示全部楼层    本楼为最佳答案   
  1. Sub 宏2()
  2. Dim source As Range
  3. Dim dic As Object, arr, brr
  4. Set dic = CreateObject("Scripting.Dictionary")
  5. Set source = Range("a2").CurrentRegion
  6. Set source = Range("a2").Resize(source.Rows.Count - 1, 2)


  7. For i = 1 To source.Rows.Count
  8. With source(i, 1)
  9. If Not dic.exists(.Text) Then
  10.     ReDim arr(1 To source.Rows.Count + 1)
  11.     arr(1) = 1
  12.     arr(2) = .Offset(0, 1).Text
  13.     dic.Add .Text, arr
  14.    
  15. Else
  16.     brr = dic(.Text)
  17.     brr(1) = brr(1) + 1
  18.     brr(brr(1) + 1) = .Offset(0, 1).Text
  19.     dic(.Text) = brr
  20. End If
  21. End With
  22. Next

  23. ReDim arr(1 To source.Rows.Count, 1 To source.Rows.Count)
  24. For i = 1 To source.Rows.Count
  25. t = dic(source(i, 1).Text)
  26. For j = 1 To t(1)
  27. arr(i, j) = t(1 + j)
  28. Next
  29. Next
  30. [C2].Resize(source.Rows.Count, source.Rows.Count) = arr
  31. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2022-4-16 16:16 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2022-4-19 19:08 | 显示全部楼层

谢谢,非常感谢
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2022-8-15 11:40 , Processed in 0.232333 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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