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

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 用VBA或宏实现对数据的排列填充
数据透视表40+个常用小技巧，让你一次学会！
12下一页
返回列表 发新帖
查看: 4622|回复: 11

[已解决]用VBA或宏实现对数据的排列填充

[复制链接]
superle!
发表于 2015-1-19 20:33 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 superle! 于 2015-1-21 14:09 编辑

J2:J为数据源，为了让数据源的数值好认，用数字顺序看明白些，J3002以下的数值会随时增加的，所以以J列最下面有值的开始取。
用VBA或是用宏来实现表2表格里BJ301:DQ18288的填充。隔0到隔5的值已经模拟出来了。
比如表2BJ324的值就是表1J3003的空值，表2BJ324往上取值从隔0到隔249都是没有隔的取值。
往右是按隔0到隔249的取值。比如表2的324行，是从J3001:J3000:J2999:依次取值填充的。这是隔0排序方式。
隔1，表2的360行，是从J3000:J2998:J2996依次取值填充的。这是隔1，以此类推，真到完成隔249的排列。

从表2的9301行开始，又从隔0开始到隔249的排序，表2的9301行以上的是以J列最后一个空值为准，从表2的9301行以下的隔0到隔249是以J列最后一个空值的上面一个值为准进行填充。也就是J3001为准。填充的方法跟上面的一样。

最佳答案
月排行榜 / 总排行榜
芐雨
2015-1-21 10:23
sorry，忘记重新定义数组
  1. Sub t()
  2.     Dim arr, lr&, rng As Range
  3.     Dim n%, m%, i&, j&, lst&
  4.     On Error Resume Next
  5.     For x = 0 To 1
  6.         ReDim brr(1 To 24, 1 To 60)
  7.         With Sheets("sheet1")
  8.             arr = .Range("J2:J" & (.Cells(Rows.Count, "J").End(3).Row) - x)   'J列最大行数减x
  9.         End With
  10.         lr = UBound(arr)
  11.         Set rng = Range("Bj301:DQ324").Offset(x * 9000)  '填充单元格起始位置

  13.         For i = 1 To 23
  14.             brr(24 - i, 1) = arr(lr - i + 1, 1)  '第一列
  15.         Next
  16.         For n = 249 To 0 Step -1     '从249到0
  17.             m = WorksheetFunction.RoundUp((lr + 1) / (n + 1), 0)    '计算最大列数
  18.             For j = 2 To m
  19.                 lst = lr - n * (j - 1) - j + 2   '起始行
  20.                 For i = 0 To 23
  21.                     brr(24 - i, j) = arr(lst - i, 1)
  22.                 Next
  23.             Next
  24.             rng.Offset(n * 36) = brr    '赋值，根据n值偏移
  25.         Next
  26.     Next
  27. End Sub
复制代码

用VBA或宏进行排列填充增加功能.rar

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

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
芐雨
发表于 2015-1-19 22:17 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
这样》？
  1. Sub t()
  2.     Dim arr, brr(1 To 24, 1 To 60)
  3.     Dim n%, i&, j&, lr&, lst&
  4.     With Sheets("sheet1")
  5.         arr = .Range("J2:J" & (.Cells(Rows.Count, "J").End(3).Row + 1))
  6.     End With
  7.     lr = UBound(arr)
  8.     Sheets("sheet2").Range("Bj301:DQ9288").ClearContents
  9.     On Error Resume Next
  10.     For i = 0 To 23
  11.         brr(24 - i, 1) = arr(lr - i, 1)    '第一列
  12.     Next
  13.     For n = 249 To 0 Step -1     '从249到0
  14.         For j = 2 To 60
  15.             lst = lr - n * (j - 1) - j + 1   '起始行
  16.             For i = 0 To 23
  17.                 brr(24 - i, j) = arr(lst - i, 1)
  18.             Next
  19.         Next
  20.         Sheets("sheet2").Range("Bj301:DQ324").Offset(n * 36) = brr    '赋值，根据n值偏移
  21.     Next
  22. End Sub
复制代码
回复

使用道具 举报

superle!
 楼主| 发表于 2015-1-19 22:31 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
芐雨 发表于 2015-1-19 22:17
这样》？

表2的BJ9301:DQ18288区域没有实现填充？
回复

使用道具 举报

芐雨
发表于 2015-1-20 06:26 | 显示全部楼层
superle! 发表于 2015-1-19 22:31
表2的BJ9301:DQ18288区域没有实现填充？

这个加个循环就好
  1. Sub t()
  2.     Dim arr, lr&, rng As Range
  3.     For i = 0 To 1
  4.         With Sheets("sheet1")
  5.             arr = .Range("J2:J" & (.Cells(Rows.Count, "J").End(3).Row) - i)   'J列最大行数减i
  6.         End With
  7.         lr = UBound(arr)
  8.         Set rng = Range("Bj301:DQ324").Offset(i * 9000)  '填充单元格起始位置
  9.         Call ff(lr, arr, rng)         '执行ff
  10.     Next
  11. End Sub
  12. Sub ff(lr, arr, rng)
  13.     Dim n%, m%, i&, j&, lst&
  14.     Dim brr(1 To 24, 1 To 60)
  15.     On Error Resume Next
  16.     For i = 1 To 23
  17.         brr(24 - i, 1) = arr(lr - i + 1, 1)  '第一列
  18.     Next
  19.     For n = 249 To 0 Step -1     '从249到0
  20.         m = WorksheetFunction.RoundUp((lr + 1) / (n + 1), 0)    '计算最大列数
  21.         For j = 2 To m
  22.             lst = lr - n * (j - 1) - j + 2   '起始行
  23.             For i = 0 To 23
  24.                 brr(24 - i, j) = arr(lst - i, 1)
  25.             Next
  26.         Next
  27.         rng.Offset(n * 36) = brr    '赋值，根据n值偏移
  28.     Next
  29. End Sub
复制代码
回复

使用道具 举报

superle!
 楼主| 发表于 2015-1-20 23:02 | 显示全部楼层
芐雨 发表于 2015-1-20 06:26
这个加个循环就好

能把代码结合在一起吗。感觉好像这个代码是分二步走的。
回复

使用道具 举报

芐雨
发表于 2015-1-21 08:23 | 显示全部楼层
合一起了。
  1. Sub t()
  2.     Dim arr, lr&, rng As Range
  3.     Dim n%, m%, i&, j&, lst&
  4.     Dim brr(1 To 24, 1 To 60)
  5.     On Error Resume Next
  6.     For x = 0 To 1
  7.         With Sheets("sheet1")
  8.             arr = .Range("J2:J" & (.Cells(Rows.Count, "J").End(3).Row) - x)   'J列最大行数减x
  9.         End With
  10.         lr = UBound(arr)
  11.         Set rng = Range("Bj301:DQ324").Offset(x * 9000)  '填充单元格起始位置

  13.         For i = 1 To 23
  14.             brr(24 - i, 1) = arr(lr - i + 1, 1)  '第一列
  15.         Next
  16.         For n = 249 To 0 Step -1     '从249到0
  17.             m = WorksheetFunction.RoundUp((lr + 1) / (n + 1), 0)    '计算最大列数
  18.             For j = 2 To m
  19.                 lst = lr - n * (j - 1) - j + 2   '起始行
  20.                 For i = 0 To 23
  21.                     brr(24 - i, j) = arr(lst - i, 1)
  22.                 Next
  23.             Next
  24.             rng.Offset(n * 36) = brr    '赋值，根据n值偏移
  25.         Next
  26.     Next
  27. End Sub
复制代码
回复

使用道具 举报

superle!
 楼主| 发表于 2015-1-21 10:03 | 显示全部楼层
芐雨 发表于 2015-1-21 08:23
合一起了。

表2的9301行以下的排序填充，不应该填充到3000右侧还有填充的。
QQ截图20150121095933.png
回复

使用道具 举报

芐雨
发表于 2015-1-21 10:23 | 显示全部楼层    本楼为最佳答案   
sorry，忘记重新定义数组
  1. Sub t()
  2.     Dim arr, lr&, rng As Range
  3.     Dim n%, m%, i&, j&, lst&
  4.     On Error Resume Next
  5.     For x = 0 To 1
  6.         ReDim brr(1 To 24, 1 To 60)
  7.         With Sheets("sheet1")
  8.             arr = .Range("J2:J" & (.Cells(Rows.Count, "J").End(3).Row) - x)   'J列最大行数减x
  9.         End With
  10.         lr = UBound(arr)
  11.         Set rng = Range("Bj301:DQ324").Offset(x * 9000)  '填充单元格起始位置

  13.         For i = 1 To 23
  14.             brr(24 - i, 1) = arr(lr - i + 1, 1)  '第一列
  15.         Next
  16.         For n = 249 To 0 Step -1     '从249到0
  17.             m = WorksheetFunction.RoundUp((lr + 1) / (n + 1), 0)    '计算最大列数
  18.             For j = 2 To m
  19.                 lst = lr - n * (j - 1) - j + 2   '起始行
  20.                 For i = 0 To 23
  21.                     brr(24 - i, j) = arr(lst - i, 1)
  22.                 Next
  23.             Next
  24.             rng.Offset(n * 36) = brr    '赋值，根据n值偏移
  25.         Next
  26.     Next
  27. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
天棋 + 3 偶像

查看全部评分

回复

使用道具 举报

superle!
 楼主| 发表于 2015-1-21 10:49 | 显示全部楼层
芐雨 发表于 2015-1-21 10:23
sorry，忘记重新定义数组

麻烦您了。
还有一个问题。
就是表1的J列的值现在只有3002行的值，到时候我数值会增加到4000行，或是8000行的时候，或数据减少到500行的时候，以现在的VBA代码点击执行时会出现空值，需要哪里修改下。


QQ截图20150121104812.png
回复

使用道具 举报

芐雨
发表于 2015-1-21 10:57 | 显示全部楼层
superle! 发表于 2015-1-21 10:49
麻烦您了。
还有一个问题。
就是表1的J列的值现在只有3002行的值，到时候我数值会增加到4000行，或是80 ...

QQ图片20150121103019.jpg

留一个空值，不是你原附件要求的吗
像原附件的例子，1下面是空值，但你的行数是要求取到3002
最后一行是以什么来确定？
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-5-18 20:13 , Processed in 0.345841 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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