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中的数据是多个字符串或多个数字，为了防止Gary的学生评论，您可以使用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

使用vba以相反的顺序将数据从一个工作表复制到另一个工作表

2 个答案: