使用vba以相反的顺序将数据从一张纸复制到另一张纸

Question

我的Excel PullData和AllStocks中有两张纸。 我想从PullData列A复制数据，并将值反向顺序粘贴到其他工作表AllStocks中。

当前，我正在使用OFFSET函数执行它。 但是我发现使用此方法运行大型数据集时出现性能问题。 有什么更好的方法可以执行此任务吗？

我的当前代码：

Sub GetData()
Dim Main As Worksheet
Dim PullData As Worksheet
Dim AllStocks As Worksheet
Dim i,m As Integer


Set RawImport = Workbooks("vwap.xlsm").Sheets("RawImport")
Set PullData = Workbooks("vwap.xlsm").Sheets("PullData")

m = PullData.Cells(Rows.Count, "A").End(xlUp).Row

For i = 3 To m

AllStocks.Range("A2:A" & i).Formula = "=OFFSET(PullData!$A$" & m & ",-(ROW(PullData!A1)-1),0)"

Next i

End Sub

Answer 1

没有循环代码：

Option Explicit

Sub GetData()        
    Dim pullDataVals As Variant

    With Workbooks("vwap.xlsm")
        With .Sheets("PullData")
            pullDataVals = Split(StrReverse(Join(Application.Transpose(.Range("A3", .Cells(.Rows.Count, "A").End(xlUp)).Value), ",")), ",")
        End With

        .Sheets("RawImport").Range("A2").Resize(UBound(pullDataVals) + 1).Value = Application.Transpose(pullDataVals)
    End With     
End Sub

只需检查工作表名称：在您的问题中，您所说的是“ PullData和AllStocks”，但是在您的代码中，某些RawImport表具有...

或者，以超压缩样式：

Sub GetData()
    With Workbooks("vwap.xlsm").Sheets("PullData")
        With .Range("A3", .Cells(.Rows.Count, "A").End(xlUp))
            .Parent.Parent.Sheets("RawImport").Range("A2").Resize(.Rows.Count).Value = Application.Transpose(Split(StrReverse(Join(Application.Transpose(.Value), ",")), ","))
        End With
    End With
End Sub

---

如果您在PullData中的数据是一个以上的字符串或一个以上的数字，以防止加里的学生所说的话，则可以使用ArrayList对象及其Reverse方法：

Sub GetData()
    Dim arr As Object
    Dim cell As Range

    Set arr = CreateObject("System.Collections.Arraylist")
    With Workbooks("vwap.xlsm")
        With .Sheets("PullData")
            For Each cell In .Range("A3", .Cells(.Rows.Count, "A").End(xlUp))
                arr.Add cell.Value
            Next
        End With
        arr.Reverse
        .Sheets("RawImport").Range("A2").Resize(arr.Count) = Application.Transpose(arr.toarray)
    End With
End Sub

Answer 2

此解决方案将INDEX公式应用于临时Name 。

Sub Range_ReverseOrder()
Const kFml As String = "=INDEX(_Src,#RowsSrc+#RowTrg-ROW(),1)"
Dim nmSrc As Name, rgTrg As Range
Dim lRows As Long, sFml As String

    Rem Set Objects
    With Workbooks("vwap.xlsm")
        lRows = .Worksheets("PullData").Cells(Rows.Count, 1).End(xlUp).Row
        Set nmSrc = .Names.Add(Name:="_Src", _
             RefersTo:=.Worksheets("PullData").Cells(2, 1).Resize(-1 + lRows, 1))
        .Names("_Src").Comment = "Range_ReverseOrder"
        Set rgTrg = .Worksheets("RawImport").Cells(2, 1).Resize(-1 + lRows, 1)
    End With

    Rem Set Formula
    sFml = kFml
    sFml = Replace(sFml, "#RowsSrc", nmSrc.RefersToRange.Rows.Count)
    sFml = Replace(sFml, "#RowTrg", rgTrg.Row)

    Rem Apply Formula
    With rgTrg
        .Offset(-1).Resize(1).Value = "Reverse.Order"
        .Formula = sFml
        .Value2 = .Value2
    End With

    Rem Delete Temporary Name
    nmSrc.Delete

    End Sub