WorksheetFunction.Transpose 方法
返回轉置單元格區域,即将一行單元格區域轉置成一列單元格區域,反之亦然。在行列數分别與數組 (數組:用于建立可生成多個結果或可對在行和列中排列的一組參數進行運算的單個公式。數組區域共用一個公式;數組常量是用作參數的一組常量。)的行列數相同的區域中,必須将 TRANSPOSE 輸入為數組公式 (數組公式:數組公式對一組或多組值執行多重計算,并返回一個或多個結果。數組公式括于大括号 ({ }) 中。按 Ctrl Shift Enter 可以輸入數組公式。)。使用 TRANSPOSE 可在工作表中轉置數組的垂直和水平方向。
Sub 單列轉置()
arr = Range("A4:A6")'arr獲取區域A4:A6數組
brr = WorksheetFunction.Transpose(arr)‘brr是arr的行列轉置
Cells(4, "F").Resize(UBound(arr, 2), UBound(arr, 1)) = brr
End Sub
以上代碼完成圖中1區Range("A4:A6") 第1列向 Cells(4, "F")即F4單元格的轉置。原來是A4一行3行,變成F4一行3列
技巧提示:
UBound(arr, 2)獲得arr數組總列數, UBound(arr, 1)獲得arrr數組總行數
arr數組總列數=1
arrr數組總行數=3,
Cells(4, "F").Resize(總列數, 總行數),表示把F4單元格resize擴展(總列數, 總行數)成為一個更大的Range區域,這個區域對應圖上就是Range("F4:H4")
Range("F4:H4")=brr完成數組寫入區域。
Sub 單行轉置()
arr = Range("A5:D5")
brr = WorksheetFunction.Transpose(arr)
Cells(9, "F").Resize(UBound(arr, 2), UBound(arr, 1)) = brr
End Sub
标志3區域向标志4區域轉置
Sub 二維轉置()
arr = Range("A4:D6")
brr = WorksheetFunction.Transpose(arr)
Cells(9, "A").Resize(UBound(arr, 2), UBound(arr, 1)) = brr
End Sub
以上兩例分别完成上表到下表的整體轉置。
Sub 超長字符測試()
sss = Application.Rept("$", 256)
'MsgBox sss
[A4] = sss
arr = Range("A4:A6")
brr = WorksheetFunction.Transpose(arr)
Cells(4, "F").Resize(UBound(arr, 2), UBound(arr, 1)) = brr
'Transpose所能夠處理的數組元素字符長度最大為255
End Sub
加入以上代碼,程序代碼立即挂掉。
sss = Application.Rept("$", 256)
sss是一個重複了256次的$長字符串,vba可以正常顯示。
如果替換A4為sss,代碼立即挂掉,轉置失敗,因為Transpose所能夠處理的數組元素字符長度最大為255。
又因為Transpose為WorksheetFunction表函數,所以也受65535行數限制,不過就算不限制,excel系統最大也隻有XFD 16384列,即使轉置成功,也隻能在内存中運算,不能寫入區域。
我用vbnet重新寫了一個新函數.能夠克服上述缺陷
Function TransposeArray(arr(,) As Object)
'自定義數組轉置,消除256長字符限制和WorksheetFunction.Transpose65536行限制
Dim brr = makearray(UBound(arr, 2), UBound(arr, 1))
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
brr(j, i) = arr(i, j)
Next
Next
Return brr
end function
測試代碼:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim ws = (New excel).activesheet
Dim arr = ws.Getgrid("A4:D6")
Dim brr = TransposeArray(arr)
ws.setgrid(brr, 4, "F")
End Sub
更多精彩资讯请关注tft每日頭條,我们将持续为您更新最新资讯!