转换表格结构一例----N行4列变成21行N列

楼主 LOGO	素材来自：http://www.exceltip.net/thread-49867-1-1.html 工作中经常由于报表使用人的的要求不同，经常要转换表格的结构。下面借用素材帖的数据原来的数据是如下图所示的4列多行的数据。现在因工作的需要，要将原数据转变成如下图所示: 第1-4列的第1行显示数据标题，第1-20行数据显示原数据的第1-20项数据，第5-8列的第1行显示数据标题，第1-20行数据显示原数据的第21-40项数据....依此类推...直到列出原数据最后一项数据为止 (忽略原数据表的空白数据-----因为原数据表的数据不是很规范，数据中间存在一些无意义的空行,所以要忽略掉这部分数据) 解决方法：VBA数组法知识点：1、借助数组，减少单元格读写次数,提高代码运行速度 2、主要是借助工作表函数创建循环序列引用数组内容说明： 1、发帖前未十分细致的搜索过社区的帖子，若重复发帖还请麻烦告知删除。 2、其实将转换后的数据转换成转换前的格式也挺好玩的，有兴趣的朋友可以试试。 VBA代码如下： Sub 结构转换() Dim arr, 总数 As Integer, 行数 As Integer, 新行数 As Integer, 列数 As Integer, 目标数 As Integer, 结果(), 标题, i As Integer, 结果行号 As Integer, 原列数 As Integer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual [I1].CurrentRegion.Clear With ActiveSheet arr =. Range("a1:d" & .Cells(Rows.Count, 1).End(xlUp).Row) End With '确定有效的数据个数总数 = WorksheetFunction.CountIf(Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row), "<>") 行数 = 20 '固定每列只显示20行数据，可根据实际情况修改新行数 = 行数+1 '设定结果列的行数为21行(20行数据+1行标题) 原列数 = 4 '原来的数据有多少列列数 = WorksheetFunction.RoundUp(总数 / 行数, 0) * 原列数 '确定结果数据总共有多少列 '将标题写入数组，本可以直接引用单元格区域创建数组的,但考虑到有时候需要选择性返回原数据的指定列 '所以用array来创建标题 = Array("工资编号", "科室名称", "姓名", "金额") ReDim 结果(1 To 新行数, 1 To 列数) For i = 1 To 列数结果(1, i) = 标题((i - 1) Mod 原列数) '借用mod生成0-3的循环序列 Next For i = 2 To UBound(arr) If Len(arr(i, 1)) > 0 Then 目标数 = 目标数 + 1 结果行号 = (目标数 - 1) Mod 行数 + 2 结果(结果行号, (WorksheetFunction.RoundUp(目标数 / 行数, 0) - 1) * 原列数 + 1) = arr(i, 1) '借用roundup生成序列1,5,9.... 结果(结果行号, (WorksheetFunction.RoundUp(目标数 / 行数, 0) - 1) * 原列数 + 2) = arr(i, 2) '借用roundup生成序列2,6,10.... 结果(结果行号, (WorksheetFunction.RoundUp(目标数 / 行数, 0) - 1) * 原列数 + 3) = arr(i, 3) '借用roundup生成序列 3,7,11.... 结果(结果行号, (WorksheetFunction.RoundUp(目标数 / 行数, 0) - 1) * 原列数 + 4) = Round(arr(i, 4), 2) '借用roundup生成序列 4,8,12.... End If Next [I1].Resize(新行数, 列数) = 结果 '写入数组 Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 数据1列只储存20行.rar
2楼 LOGO	with 。 end with 结构中我经常会把.忘掉,这确实是一值得注意的地方计算总数与目标数用的标准不一，这里只是考虑到数据规范，各列不会存在缺失的情况。还是没考虑周全，确实是应该前后一致的，这样还论是逻辑还是容错性上都会更加好。非常感谢小千版主的指正。
3楼 0Mouse	With ActiveSheet arr = Range("a1:d" & Cells(Rows.Count, 1).End(xlUp).Row) End With 红色部分应该没有必要，确实要保留，那应该在Range和Cells之前加上.，否则with……end with就没什么意义了，应该是遗漏了吧！另外，你计算总行数根据的是A列，而计算目标数却是根据B列，这个感觉统一一下会更好些，要不然我故意改一下源数据，代码就可能报错了。附件： xqoa.rar
4楼 0Mouse	Range和Cells前面要不要加限定工作表和代码所放的位置以及活动工作表的变化是有关系的，比较一下图中4个Range("A1")各是指哪张工作表？附件： xqoa2.rar
5楼 LOGO	再次感谢小千版主！
6楼水星钓鱼	学习下