为了账号安全,请及时绑定邮箱和手机立即绑定

在VBA中转置范围

/ 猿问

在VBA中转置范围

富国沪深 2019-11-19 15:34:32

我正在尝试通过VBA宏在Excel中转置一系列单元格,但出现一些错误,主要是错误91。


我对VBA还是很陌生,对功能也不是很了解。


Range(InRng).Select

Set Range1 = Selection

Dim DestRange As Range

Set DestRange = Application.WorksheetFunction.Transpose(Range1)

经过几个论坛之后,这就是我的想法。需要注意的一件事是,我不必将它们复制到任何其他单元格中。


我要实现的目标是创建一个协方差方法,并且在选项窗口中,用户可以选择范围,然后按列或按行选择,这将影响所得的协方差矩阵。


查看完整描述

3 回答

?
米脂

这使您可以将X和X'作为变量数组传递给另一个函数。


Dim X() As Variant

Dim XT() As Variant

X = ActiveSheet.Range("InRng").Value2

XT = Application.Transpose(X)

要将转置值作为范围,您必须通过此工作表中的答案来传递它。如果不了解协方差函数的工作原理,很难看到所需的东西。


查看完整回答
反对 回复 2019-11-19
?
哔哔one

首先复制源范围,然后使用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函数采用Varaiant类型的参数并返回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是具有1至1、1至8维的2D Variant-Array。当您调用Transpose(Range(“ a1:h1”)。Value)时,您将获得尺寸为1至8、1至1的转置2D Variant数组。并且,如果您调用Transpose(Transpose(Range(“ a1:h1”)。Value))),则会获得1D变量数组,其维数为1到8。


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


如果源范围将具有更多行(列),例如“ a1:h3”,则转置函数仅更改尺寸,如下所示:1到3、1到8转置到1到8、1到3,反之亦然。


希望我没有让你感到困惑,我的英语不好,对不起:-)。


查看完整回答
反对 回复 2019-11-19
?
翻过高山走不出你

这样的事情应该为您做。


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/transposed.htm


查看完整回答
反对 回复 2019-11-19

添加回答

回复

举报

0/150
提交
取消
意见反馈 帮助中心 APP下载
官方微信