Question

我想做的是从＆＃34; Sheet1＆＃34;复制范围（B4：AD22）。并将所有值粘贴到＆＃34; Sheet2上的单个列（B2）中。＆＃34;我必须对Sheet2上的多个范围和列执行此操作，即Fromt＆＃34; Sheet1＆＃34;：范围（B27：AD45），以及Sheet2上的列O2。

我会在VBA中轻松编辑sheet2上的源范围和目标列。任何帮助表示赞赏。

这是我见过的唯一能够准确完成我需要它的代码。我唯一的问题是，我对VBA还不熟悉，也不知道如何删除＆＃34;应用程序＆＃34;这个VBA代码。我也不需要选择范围，因为它总是恒定的，B4：AD22，B27：AD45，依此类推。我也不知道如何制作它，以便在同一个脚本中容纳多个范围选择。代码以其当前形式，似乎也不支持在第二张纸上粘贴值。甚至不知道它是否可能。

Sub ConvertRangeToColumn()
'Updateby20131126
Dim Range1 As Range, Range2 As Range, Rng As Range
Dim rowIndex As Integer
xTitleId = "KutoolsforExcel"
Set Range1 = Application.Selection
Set Range1 = Application.InputBox("Source Ranges:", xTitleId, Range1.Address, Type:=8)
Set Range2 = Application.InputBox("Convert to (single cell):", xTitleId, Type:=8)
rowIndex = 0
Application.ScreenUpdating = False
For Each Rng In Range1.Rows
Rng.Copy
Range2.Offset(rowIndex, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
rowIndex = rowIndex + Rng.Columns.Count
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Answer 1

这对我有用：

Sub Tester()
    ToColumn ActiveSheet.Range("A1:C3"), _
                         Sheets("Sheet2").Range("A1")

    ToColumn ActiveSheet.Range("B4:AD22"), _
                         Sheets("Sheet2").Range("B1")
End Sub


Sub ToColumn(rngIn As Range, topCell As Range)

    Dim rv() As Variant, n As Long, d, r As Long, c As Long
    Dim nR As Long, nC As Long, i As Long

    d = rngIn.Value
    nR = UBound(d, 1)
    nC = UBound(d, 2)
    n = nR * nC
    ReDim rv(1 To n, 1 To 1)
    i = 0
    For r = 1 To nR
    For c = 1 To nC
        i = i + 1
        rv(i, 1) = d(r, c)
    Next c
    Next r

    topCell.Resize(n, 1).Value = rv
End Sub

将多个范围转换为另一个工作表上的单个列

1 个答案: