Excel精英培训网

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

[已解决]VBA数组的问题

[复制链接]
发表于 2017-8-11 16:55 | 显示全部楼层 |阅读模式
求助VBA
最佳答案
2017-8-11 21:58
Sub ex()
    Dim xD As Range, Arr()
    Set xD = Sheet1.[a1].CurrentRegion
    m = (xD.Rows.Count - 1) * (xD.Columns.Count - 2) + 1
    ReDim Preserve Arr(1 To m, 1 To 4)
    Arr(1, 1) = "科室"
    Arr(1, 2) = "姓名"
    Arr(1, 3) = "上休"
    Arr(1, 4) = "日期"

    n = 1
    For r = 2 To xD.Rows.Count
        For c = 3 To xD.Columns.Count
            n = n + 1
            Arr(n, 1) = xD(r, 1) '"科室"
            Arr(n, 2) = xD(r, 2) '"姓名"
            Arr(n, 3) = xD(r, c) '"上休"
            Arr(n, 4) = xD(1, c) '"日期"
        Next
    Next
   
    With Sheet3
        .[a1].Resize(n + 1, 4) = ""
        .[a1].Resize(n, 4) = Arr
    End With
End Sub

1.rar

7.66 KB, 下载次数: 10

发表于 2017-8-11 21:58 | 显示全部楼层    本楼为最佳答案   
Sub ex()
    Dim xD As Range, Arr()
    Set xD = Sheet1.[a1].CurrentRegion
    m = (xD.Rows.Count - 1) * (xD.Columns.Count - 2) + 1
    ReDim Preserve Arr(1 To m, 1 To 4)
    Arr(1, 1) = "科室"
    Arr(1, 2) = "姓名"
    Arr(1, 3) = "上休"
    Arr(1, 4) = "日期"

    n = 1
    For r = 2 To xD.Rows.Count
        For c = 3 To xD.Columns.Count
            n = n + 1
            Arr(n, 1) = xD(r, 1) '"科室"
            Arr(n, 2) = xD(r, 2) '"姓名"
            Arr(n, 3) = xD(r, c) '"上休"
            Arr(n, 4) = xD(1, c) '"日期"
        Next
    Next
   
    With Sheet3
        .[a1].Resize(n + 1, 4) = ""
        .[a1].Resize(n, 4) = Arr
    End With
End Sub
回复

使用道具 举报

 楼主| 发表于 2017-8-12 10:41 | 显示全部楼层
AmoKat 发表于 2017-8-11 21:58
Sub ex()
    Dim xD As Range, Arr()
    Set xD = Sheet1.[a1].CurrentRegion

谢谢
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 17:37 , Processed in 2.496320 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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