实际问题记录

VBA脚本实现特殊的行转列

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

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

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

答：

Sub doAction()
    For i = 0 To 12 '处理Sheet2中的每一行
        Sheets("Sheet2").Select
            Range(Cells(i + 2, 2), Cells(i + 2, 2)).Select
            Selection.Copy
        Sheets("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).Select
            ActiveSheet.Paste
            Range(Cells(i * 3 + 3, 3), Cells(i * 3 + 5, 3)).Merge 
            Range(Cells(i * 3 + 3, 3), Cells(i * 3 + 5, 3)).Interior.ColorIndex = xlNone
            
            For j = 0 To 2 '处理Sheet2中的每一行黄色单元格后的3个单元格
                Sheets("Sheet2").Select
                    Range(Cells(i + 2, j + 3), Cells(i + 2, j + 3)).Select
                    Selection.Copy
                Sheets("Sheet1").Select
                    Cells(i * 3 + 3 + j, 4).Select
                    ActiveSheet.Paste
            Next j
    Next i
End Sub