实际问题记录

VBA脚本实现特殊的行转列

已知：位于同一Excel工作簿文件中的两个工作表：Sheet1、Sheet2。

问题：现要将Sheet2中的每一行，按Sheet1中的样子进行转置：

1. Sheet2中每一行的黄色单元格，为列头。要求以合并3列单元格的方式纵向排列。
2. Sheet2中每一行黄色单元格之后的3个单元格，分别为一级次列、二级次列和三级次列。要求纵向排列。

答：

Sub doAction()For i = 0 To 12 '处理Sheet2中的每一行Sheets("Sheet2").SelectRange(Cells(i + 2, 2), Cells(i + 2, 2)).SelectSelection.CopySheets("Sheet1").Select'当i=0时，黄色单元格应置于Sheet1的C3位置；当i=1时，黄色单元格应置于Sheet1的C6位置；当i=2时，黄色单元格应置于Sheet1的C9位置。'所以发现规律：i=0, 0*3+3=3; i=1, 1*3+3=6; i=2, 2*3+3=9。'所以应将每行的黄色单元格粘贴到Sheet1中的i * 3 + 3位置。Cells(i * 3 + 3, 3).SelectActiveSheet.PasteRange(Cells(i * 3 + 3, 3), Cells(i * 3 + 5, 3)).Merge Range(Cells(i * 3 + 3, 3), Cells(i * 3 + 5, 3)).Interior.ColorIndex = xlNoneFor j = 0 To 2 '处理Sheet2中的每一行黄色单元格后的3个单元格Sheets("Sheet2").SelectRange(Cells(i + 2, j + 3), Cells(i + 2, j + 3)).SelectSelection.CopySheets("Sheet1").SelectCells(i * 3 + 3 + j, 4).SelectActiveSheet.PasteNext jNext i
End Sub