在 VBA 中转置范围

Question

我正在尝试通过 VBA 宏转置 Excel 中的一系列单元格，但我遇到了一些错误，主要是错误 91。

我对 VBA 很陌生，对函数也不太了解。

Range(InRng).Select
Set Range1 = Selection
Dim DestRange As Range
Set DestRange = Application.WorksheetFunction.Transpose(Range1)

在浏览了几个论坛之后，这就是我想出的。需要注意的一件事是我不必将它们复制到任何其他单元格中。

我想要实现的是创建一个协方差方法，在选项窗口中，用户可以选择选择范围，然后按列或行进行选择，这将影响生成的协方差矩阵。

Answer 1

这会将 X 和 X' 作为变量数组传递给另一个函数。

Dim X() As Variant
Dim XT() As Variant
X = ActiveSheet.Range("InRng").Value2
XT = Application.Transpose(X)

要将转置后的值作为一个范围，您必须通过this answer 中的工作表传递它。如果不了解您的协方差函数是如何工作的，就很难看到您需要什么。

Answer 2

首先复制源范围，然后使用 Transpose:=True，短样本在目标范围上进行特殊粘贴：

Option Explicit

Sub test()
  Dim sourceRange As Range
  Dim targetRange As Range

  Set sourceRange = ActiveSheet.Range(Cells(1, 1), Cells(5, 1))
  Set targetRange = ActiveSheet.Cells(6, 1)

  sourceRange.Copy
  targetRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

Transpose 函数接受 Variant 类型的参数并返回 Variant。

  Sub transposeTest()
    Dim transposedVariant As Variant
    Dim sourceRowRange As Range
    Dim sourceRowRangeVariant As Variant

    Set sourceRowRange = Range("A1:H1") ' one row, eight columns
    sourceRowRangeVariant = sourceRowRange.Value
    transposedVariant = Application.Transpose(sourceRowRangeVariant)

    Dim rangeFilledWithTransposedData As Range
    Set rangeFilledWithTransposedData = Range("I1:I8") ' eight rows, one column
    rangeFilledWithTransposedData.Value = transposedVariant
  End Sub

我将尝试解释'调用转置两次'的目的。 如果您在 Excel 中有 行数据，例如"a1:h1" 那么 Range("a1:h1").Value 是一个 2D Variant-Array 维度为 1到 1、1 到 8。 当你调用 Transpose(Range("a1:h1").Value) 然后你得到转置 2D Variant Array 尺寸 1 到 8, 1 到 1。如果你调用 Transpose(Transpose(Range("a1:h1").Value)) 你会得到 1D Variant Array，维度为 1 到 8。强>

第一次转置将行更改为列，第二次转置将列更改回行，但只有一个维度。

如果源范围将有更多行（列），例如"a1:h3" 然后转置函数只是像这样改变尺寸：1 到 3、1 到 8 转置到 1 到 8、1 到 3，反之亦然。

希望我没有把你弄糊涂，我的英语不好，抱歉:-)。

Answer 3

您不需要这样做。以下是如何创建协方差方法：

http://www.youtube.com/watch?v=RqAfC4JXd4A

您也可以使用 Excel 自带的统计分析包。

Answer 4

严格按照书中的“转置”开头，任何一个都可以；即 application.transpose() 或 worksheetfunction.transpose()，根据经验，如果您真的喜欢打字，application.WorksheetFunction.Transpose() 也可以使用-

Answer 5

这样的事情应该为你做。

Sub CombineColumns1()
    Dim xRng As Range
    Dim i As Long, j As Integer
    Dim xNextRow As Long
    Dim xTxt As String
    On Error Resume Next
    With ActiveSheet
        xTxt = .RangeSelection.Address
        Set xRng = Application.InputBox("please select the data range", "Kutools for Excel", xTxt, , , , , 8)
        If xRng Is Nothing Then Exit Sub
        j = xRng.Columns(1).Column
        For i = 4 To xRng.Columns.Count Step 3
            'Need to recalculate the last row, as some of the final columns may not have data in all rows
            xNextRow = .Cells(.Rows.Count, j).End(xlUp).Row + 1

            .Range(xRng.Cells(1, i), xRng.Cells(xRng.Rows.Count, i + 2)).Copy .Cells(xNextRow, j)
            .Range(xRng.Cells(1, i), xRng.Cells(xRng.Rows.Count, i + 2)).Clear
        Next
    End With
End Sub

你也可以这样做。

Sub TransposeFormulas()
    Dim vFormulas As Variant
    Dim oSel As Range
    If TypeName(Selection) <> "Range" Then
        MsgBox "Please select a range of cells first.", _
                vbOKOnly + vbInformation, "Transpose formulas"
        Exit Sub
    End If
    Set oSel = Selection
    vFormulas = oSel.Formula
    vFormulas = Application.WorksheetFunction.Transpose(vFormulas)
    oSel.Offset(oSel.Rows.Count + 2).Resize(oSel.Columns.Count, oSel.Rows.Count).Formula = vFormulas
End Sub

更多信息请参见此处。

http://bettersolutions.com/vba/arrays/transposing.htm

Answer 6

如果您只想复制和转置剪贴板中的值，您可以使用以下 makro：

Sub PasteVal()
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
End Sub