将一个工作表中的列中的范围转移到另一个工作表中的行

Question

我在一张纸上有一个专栏

我正在尝试将其转移到同一工作簿上的另一张工作表。它必须如下图所示。这些值必须出现在第一个 ID 列之后。

我在阅读和观看视频后尝试了以下代码。我进一步尝试识别 Sheet2 中的 lastrow 并将 Sheet1 中的值粘贴到下一个可用行。

Sub Transpose()

Dim SourceSheet As Worksheet
Dim TransferSheet As Worksheet
Dim inRange, outRange As Range
Dim finalrow As Integer
Dim i As Integer

'Assign
Set SourceSheet = Sheets("Sheet1")
Set TransferSheet = Sheets("Sheet2")

SourceSheet.Activate
Set inRange = ActiveSheet.Range("B2:B11")
inRange.Copy

'TRANSFER
TransferSheet.Activate
finalrow = TransferSheet.Cells(Rows.Count, 1).End(xlUp).Row 'find last row

For i = 2 To 11
    outRange = TransferSheet.Range(Cells(ii, finalrow), Cells(ii, finalrow))
    outRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next i

End Sub

Answer 1

这是我的 cmets 的一个示例

Option Explicit
Public Sub MyTranspose()
    'This assumes column to row transpose
    Dim SourceSheet As Worksheet, TransferSheet As Worksheet
    Dim inRange As Range, inRangeValues() As Variant, outRangeValues() As Variant
    Dim finalRow As Long

    Set SourceSheet = ThisWorkbook.Worksheets("Sheet1") 'Assign reference
    Set TransferSheet = ThisWorkbook.Worksheets("Sheet2")
    Set inRange = SourceSheet.Range("B2:B11")
    inRangeValues() = inRange.Value 'generate 2d array
    outRangeValues = Application.Transpose(inRangeValues)

    With TransferSheet 'Hold reference to parent worksheet
        finalRow = .Cells(Rows.Count, 1).End(xlUp).Row 'find last row
        If inRange.Columns.Count > 1 Then '2d array for output
            .Cells(finalRow + 1, 2).Resize(UBound(outRangeValues, 1), UBound(outRangeValues, 2)) = outRangeValues 'Resize according to output array dimensions
        Else '1D array for output
            .Cells(finalRow + 1, 2).Resize(1, UBound(outRangeValues, 1)) = outRangeValues
            End If
    End With
End Sub

这些是我的 cmets（加上一点）：

使用Long 而不是Integer，inRange 需要显式声明为Range 而不是隐式声明为Variant。对于Dim inRange, outRange As Range，只有outRange 是Range。你需要Dim inRange As Range, outRange As Range。

在创建对 Range 对象的引用时，您需要 Set，例如Set outRange = TransferSheet.Range(Cells(ii, finalrow), Cells(ii, finalrow));这里Cells 将引用当前活动的工作表，并且从未声明ii，但您使用的是一个名为i 的循环变量 - 错字？除此之外，我不确定pastespecial 也可以在那里工作。

我会（取决于inRange 的大小，因为Transpose 有一个限制，之后会截断或抱怨）读入数组，使用Transpose 函数并使用Resize 写出。

使用Worksheets 集合而不是Sheets。使用父工作表名称完全限定单元格引用；当您在变量中有这些时，只需使用适当的变量名称。这样您就不需要Activesheet 和Activate，因此您的代码将不易出错（显式工作表引用）和更快（由于未激活工作表）。

给你的 sub 一个不同于现有 VBA 方法的名称（比我使用的更好，但仍然具有描述性。

Answer 2

请试试这个：

   Dim SourceSheet As Worksheet, TransferSheet As Worksheet
   Dim rowVal As Variant, nrCol As Long, ColumnLetter As String
   Set SourceSheet = ActiveWorkbook.Sheets("Sheet1")
   Set TransferSheet = ActiveWorkbook.Sheets("Sheet2")
     rowVal = SourceSheet.Range("B2:B11")
     nrCol = UBound(rowVal)
     ColumnLetter = Split(Cells(1, nrCol + 1).Address, "$")(1)
     TransferSheet.Range("B2:" & ColumnLetter & 2) = Application.WorksheetFunction.Transpose(rowVal)

因此，代码像您一样声明了两个页面。 然后 B:B 列中的范围包含在 rowVal 数组中。列数定义为Ubound(rowVal)，用于粘贴值的工作表的列字母确定为ColumnLetter。使用 nrCol + 1 是因为粘贴单元格将位于 B:B 列（第二列）中，并且计数不会从第一列开始。 然后，使用Transpose 函数将数组内容粘贴到TransferSheet 相应的行中。范围列是使用之前确定的ColumnLetter...