Excel精英培训网

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

一数字代表某段数据,按要求写入指定区域如何实现?

[复制链接]
发表于 2020-6-16 17:02 | 显示全部楼层 |阅读模式
3学分
本帖最后由 cys888 于 2020-6-17 10:03 编辑


新建 Microsoft Office Excel 工作表.rar

20.69 KB, 下载次数: 11

最佳答案

查看完整内容

Sub test() Dim A, B, i, j, k A = .Resize(1, 30) B = Range("b9:m" & Range("b65536").End(xlUp).Row) For i = 1 To UBound(B) For j = 1 To 3 For k = 1 To 3 B(i, j * 3 + k) = A(1, (B(i, j) - 1) * 3 + k) Next k Next j Next i .Resize(UBound(B), UBound(B, 2)) = B End Sub
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2020-6-16 17:02 | 显示全部楼层
QQ截图20200616205428.jpg


Sub test()
    Dim A, B, i, j, k
    A = [b1].Resize(1, 30)
    B = Range("b9:m" & Range("b65536").End(xlUp).Row)

    For i = 1 To UBound(B)
        For j = 1 To 3
            For k = 1 To 3
                B(i, j * 3 + k) = A(1, (B(i, j) - 1) * 3 + k)
            Next k
        Next j
    Next i

    [b9].Resize(UBound(B), UBound(B, 2)) = B
End Sub

评分

参与人数 1学分 +3 收起 理由
cys888 + 3

查看全部评分

回复

使用道具 举报

发表于 2020-6-16 21:13 | 显示全部楼层
感觉有点累赘。
  1. Sub test()
  2. Dim arr, arrRule, arrRst, i&, j&, k&, n&
  3. arr = Range("b9:d" & Cells(Rows.Count, 2).End(3).Row)
  4. ReDim arrRst(1 To UBound(arr), 1 To 9)
  5. arrRule = [b1:ae1]
  6. For i = 1 To UBound(arr)
  7.   For j = 1 To 3
  8.     n = (j - 1) * 3
  9.     For k = n + 1 To n + 3
  10.       arrRst(i, k) = arrRule(1, (arr(i, j) - 1) * 3 + k - n)
  11.     Next k
  12.   Next j
  13. Next i
  14. [e9].Resize(UBound(arr), 9) = arrRst
  15. End Sub
复制代码

评分

参与人数 1学分 +3 收起 理由
cys888 + 3

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2020-6-17 10:01 | 显示全部楼层
爱疯 发表于 2020-6-16 20:55
Sub test()
    Dim A, B, i, j, k
    A = .Resize(1, 30)

非常感谢
回复

使用道具 举报

 楼主| 发表于 2020-6-17 10:02 | 显示全部楼层

非常感谢
回复

使用道具 举报

发表于 2020-6-17 10:32 | 显示全部楼层
下次发帖,如果把说明文字放在帖子中并截图,会更好些。
回复

使用道具 举报

发表于 2020-6-17 13:45 | 显示全部楼层
E9:M15=OFFSET($A$1,,MATCH(OFFSET($A9,,INT(COLUMN(C1)/3)),$2:$2,)-2+MOD(COLUMN(A1)-1,3))
7052.png
回复

使用道具 举报

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

本版积分规则

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

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

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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