ExcelWorksheetFunction.Transpose转置函数用法及缺陷（ExcelWorksheetFunction.Transpose转置函数用法及缺陷）

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