VBA 使用数组复制大型数据集

问题描述 投票:0回答:2

我在工作表 A 上有数据,想将其复制到工作表 B 上。因为数据很多,所以我不想使用复制粘贴。如果我真的简化它,这就是我的代码。尽管我在这个简化的代码中对其进行了固定,但我的范围发生了变化。我不想使用类似 range("A1:BBB100000") 的东西,因为我的范围会改变。我收到 1004 错误“应用程序定义或对象定义错误”。我做错了什么?

Dim origin(1 to 100000, 1 to 100000) as Variant
Dim dest(1 to 100000, 1 to 100000) as Variant

Set A=Worksheets("A")
Set B=Worksheets("B")
Vrow=100000

set origin=A.range(cells(1,1),cells(Vrow, Vrow))
set dest=B.range(cells(1,1),cells(Vrow, Vrow))
dest=origin 
arrays excel vba multidimensional-array
2个回答
0
投票

你不需要数组。仅当您实际上要对其进行任何计算时才生成数组。如果你只想做价值 -> 价值,那么这就是你所做的(如下所示)。

请记住始终声明所有变量。

Dim A As Worksheet, B As Worksheet, Vrow As Long
Set A = Worksheets("A")
Set B = Worksheets("B")
Vrow = 100000

B.Range(B.Cells(1, 1), B.Cells(Vrow, Vrow)).Value = A.Range(A.Cells(1, 1), A.Cells(Vrow, Vrow)).Value

0
投票

将范围值复制到另一个工作表

Sub CopyValues()

    Const sName As String = "A"
    Const sFirstCellAddress As String = "A1"
    Const dName As String = "B"
    Const dFirstCellAddress As String = "A1"

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim sfCell As Range: Set sfCell = sws.Range(sFirstCellAddress)
    Dim srg As Range: Set srg = sfCell.CurrentRegion
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dfCell As Range: Set dfCell = dws.Range(dFirstCellAddress)
    Dim drg As Range: Set drg = dfCell.Resize(srg.Rows.Count, srg.Columns.Count)
    
    drg.Value = srg.Value
    
End Sub


Sub CopyValuesShorter()

    Dim srg As Range
    Set srg = ThisWorkbook.Worksheets("A").Range("A1").CurrentRegion
    
    Dim drg As Range
    Set drg = ThisWorkbook.Worksheets("B").Range("A1") _
        .Resize(srg.Rows.Count, srg.Columns.Count)
    
    drg.Value = srg.Value
    
End Sub


Sub CopyValuesShortest()

    With ThisWorkbook.Worksheets("A").Range("A1").CurrentRegion
        ThisWorkbook.Worksheets("B").Range("A1") _
            .Resize(.Rows.Count, .Columns.Count).Value = .Value
    End With
    
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.