Question

我想创建一个Excel自定义函数，它可以反转默认的TRANSPOSE函数的顺序。

为了简化我的问题，我主要想要在A1：C1中转换数据并使其以相反的顺序出现在A2：A4中，其中A1中的数据出现在A4中，B1出现在A3中，C1出现在A2中。

到目前为止，我已经创建了一个名为“Reverse”的函数，它包含默认的TRANSPOSE函数，如下所示：{Reverse（TRANSPOSE（A1：A3））}。

代码如下：

Function Reverse(SelectRange As Variant)

Dim InputArray() As Variant
Dim OutputArray() As Variant
Dim x As Integer
Dim y As Integer

InputArray() = SelectRange
ReDim OutputArray(1 To UBound(InputArray), 1)

For y = 1 To UBound(InputArray)
OutputArray(y, 1) = InputArray(UBound(InputArray) - y + 1, 1)
Next y

Reverse = OutputArray

End Function

然而，这在A2：A4中输出0而不是所需的值。我已经检查过使用立即窗口正确填充了OutputArray，但无论出于何种原因，它的值都无法显示。

Answer 1

OutputArray的第二维包含两个索引 - 0和1。您正在填充后者的值，Excel显示前者，因为您在单个列中输入公式。

您希望模块开头有ReDim OutputArray(1 To UBound(InputArray), 1 to 1)或Option Base 1。

Answer 2

我实际上已经找到了解决方案。我创建了一个单独的子程序，它翻转顺序而不是将代码保留在函数中，然后我从核心函数调用子程序。

以下代码稍微修改了我之前发布的代码，因为它结合了＆＃34;反向＆＃34;的功能。和＆＃34; TRANSPOSE＆＃34;转换为一个函数＆＃34; ReverseTranspose＆＃34;。它只需要输入{ReverseTranspose（A1：A3）}才能工作。我确信这可以更好地进行优化，但它可以按照我的预期工作：

Function ReverseTranspose(SelectRange As Range)

Dim InputArray() As Variant

InputArray() = Application.WorksheetFunction.Transpose(SelectRange.Value)

Call FlipArray(InputArray)

ReverseTranspose = InputArray

End Function

Sub FlipArray(InputArray As Variant)

Dim OutputArray() As Variant
Dim y As Integer

ReDim OutputArray(1 To UBound(InputArray), 1)

For y = 1 To UBound(InputArray)
OutputArray(y, 1) = InputArray(UBound(InputArray) - y + 1, 1)
Next y

For y = 1 To UBound(InputArray)
InputArray(y, 1) = OutputArray(y, 1)
Next y

End Sub

Answer 3

显示为次要但相同的想法：

Option Explicit

Public Sub test()

Dim selectRange As Range
Dim destRange As Range

With ActiveSheet

    Set selectRange = .Range("A1:C1")
    Set destRange = .Range("A2")

End With

Reverse selectRange, destRange

End Sub

Private Sub Reverse(ByVal selectRange As Range, ByVal destRange As Range)

Dim InputArray() As Variant
Dim OutputArray() As Variant
Dim x As Long
Dim y As Long

InputArray() = selectRange.Value   '1 to 1 , 1 to 3 so output should be 1 to 3, 1 to 1. Each column becomes row

ReDim OutputArray(1 To UBound(InputArray, 2), 1 To UBound(InputArray, 1))
Dim counter As Long

For x = LBound(InputArray, 1) To UBound(InputArray, 1)

    For y = UBound(InputArray, 2) To LBound(InputArray, 2) Step -1

        counter = counter + 1

        OutputArray(counter, x) = InputArray(x, y)

    Next y

Next x

destRange.Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray

End Sub

VBA UDF - 反向转置

3 个答案: