VBA 转置

Public Sub a()Dim sr1 As Integer: sr1 = Selection.Item(1).RowDim sr2 As Integer: sr2 = 1Dim i As Long: i = 1Do While i <= Selection.CountFor j = ColumnStart(Selection) To ColumnEnd(Selection)If Not IsEmpty(Selection.Item(i)) ThenFor k = 1 To Selection.Item(1).Column - 1Sheet2.Cells(sr2, k) = Sheet1.Cells(sr1, k)Next kSheet2.Cells(sr2, k) = Sheet1.Cells(Selection.Item(1).Row - 1, j)Sheet2.Cells(sr2, k + 1) = Selection.Item(i).Valuesr2 = sr2 + 1End Ifi = i + 1Next jsr1 = sr1 + 1LoopMsgBox "完成!"End SubPrivate Function ColumnCount(ByVal s As Range) As IntegerColumnCount = s.Columns.CountEnd FunctionPrivate Function ColumnStart(ByVal s As Range) As IntegerColumnStart = s.Item(1).ColumnEnd FunctionPrivate Function ColumnEnd(ByVal s As Range) As IntegerColumnEnd = ColumnStart(s) + ColumnCount(s) - 1End Function