Вставить строку из массива

Question

Я пытался часами вставлять одну строку из массива VBA в лист Excel.

Код должен быть похож на это:

Dim wsSource As Worksheet 
Set wsSource = Sheets("Data Retrieval - Source") 
Dim wsDestination As Worksheet 
Set wsDestination = Sheets("Data Retrieval - Destination") 
Dim TableAbarSource 
TableAbarSource = wsSource.Range("A3:U299729") 

wsDestination.Range("A3:Z3") = ? 

Любая идея?

Большое вам спасибо за помощь!

Добавлен оригинальный код (который отлично работает), который мне нужно оптимизировать ниже. Как вы можете видеть, существует около 300 000 циклов, поэтому объявление таблиц как переменных имеет смысл.

Sub DataRetrieval() 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

'Variable definitions 
    'Worksheets 
Dim wsSource As Worksheet 
Set wsSource = Sheets("Data Retrieval - Source") 
Dim wsDestination As Worksheet 
Set wsDestination = Sheets("Data Retrieval - Destination") 
Dim wsDefaultList As Worksheet 
Set wsDefaultList = Sheets("Default List") 

    'Core ID 
Dim CoreIDSource As Long 'Core ID number of the sheet Data Retrieval - Source 
Dim CoreIDModel As Long 'Core ID number of the sheet Model 
Dim ComparingCoreID As Variant 

    'Count 
Dim RowCountSource As Long 'Count the rows of the sheet Data Retrieval - Source 
Dim RowCountDestination As Long 'Count the rows of the sheet Data Retrieval (destination) 
RowCountDestination = 4 

'Preparing sheet Data Retrieval (destination) 
wsDestination.Range("A3:CC500000").Delete 

With wsSource 'Copy header 
    .Range(.Cells(3, 1), .Cells(3, 200)).Copy wsDestination.Cells(3, 1) 'Copy table header 
End With 

'Comparing Core ID of source sheet to Core ID of Model sheet 
For RowCountSource = 4 To 300000 

    CoreIDSource = wsSource.Cells(RowCountSource, 2) 

    Set ComparingCoreID = wsDefaultList.Range("B4:B1507").Cells.Find(What:=CoreIDSource, LookIn:=xlFormulas, _ 
     LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False) 'Definition of the Find variable 'Do not use variables for range to save time 

    If Not ComparingCoreID Is Nothing Then 
     With wsSource 
     .Range(.Cells(RowCountSource, 1), .Cells(RowCountSource, 200)).Copy wsDestination.Cells(RowCountDestination, 1) 'Copier les données chiffrées 
     End With 
     RowCountDestination = RowCountDestination + 1 
    End If 

Next RowCountSource 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

End Sub 

Answer 1

Там, наверное, 100 различных способов сделать это:

Sub test() 

Dim rSource As Range 
Dim rDest As Range 

Set rSource = Sheet1.Range("A1:D100") 
Set rDest = Sheet2.Range("A1") 
Call rSource.Resize(1).Copy(rDest) 

End Sub 

Нечто подобное может быть достаточно хорошим. Alter линию вызова, как требуется от:

rSource.Resize(1).Copy(rDest) 

Чтобы что-то вроде:

Call rSource.Resize(1).offset(10).Copy(rDest) 

Answer 2

Я нашел решение. Использование цикла для вставки данных строки в массив на самом деле довольно быстро. Весь макрос занимает около 5 млн для запуска, по сравнению с более чем 30 млн для исходного кода.

Уловка здесь заключалась в том, чтобы сломать 300 000 строк на более мелкие блоки из 25 000 строк, чтобы избежать ошибки «из памяти».

Вот код, может быть, это поможет кому-то.

Sub DataRetrieval() 
'This macro retrieves the Database data of defaulted companies. 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

'VARIABLE DECLARATION 
'Worksheets 
Dim wsSource As Worksheet 
Set wsSource = Sheets("Data Retrieval - Source") 
Dim wsDestination As Worksheet 
Set wsDestination = Sheets("Data Retrieval - Destination") 
Dim wsDefaultList As Worksheet 
Set wsDefaultList = Sheets("Default List") 

'Core ID 
Dim CoreIDSource As Long 'Core ID number of the sheet Data Retrieval - Source 
Dim CoreIDModel As Long 'Core ID number of the sheet Model 
Dim ComparingCoreID As Variant 

'Count 
Dim RowCountSource As Long 'Count the rows of the sheet Data Retrieval - Source 
Dim RowCountDestination As Long 'Count the rows of the sheet Data Retrieval (destination) 
RowCountDestination = 0 
Dim ColumnCountDestination As Byte 

'Tables 
Dim TableSource() 'Dynamic table that will store data retrieved from Database 
Erase TableSource 'Empty memory to avoid execution issues in case the program breaks before completion 
'(tables also erased at the end) 
Dim TableDestination(50000, 49) 'Table that will store the data from TableSource. Can store up to 50 columns 
Erase TableDestination 
Dim TableCoreID() 'Table that will store the list of revised CoreID 
TableCoreID = wsDefaultList.Range("B5:B2000") 'First number is 1, not zero. The table is defined like that to avoid 
'issues if one of the Core ID is blank (in that case, a table defined dynamically would stop at the blank cell) 

'FORMATTING DESTINATION SHEET 
'Preparing sheet Data Retrieval (destination) 
wsDestination.Range("A3:CC500000").ClearContents 

'Copy header 
wsSource.Rows(3).Copy 
wsDestination.Rows(3).PasteSpecial xlPasteValues 

'Format header 
With wsDestination.Rows(3) 
    .NumberFormat = "@" 
    .VerticalAlignment = xlCenter 
    .HorizontalAlignment = xlRight 
    With .Font 
     .Name = "Arial" 
     .FontStyle = "Bold" 
     .Size = 8 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorDark1 
    End With 
    With .Interior 
     .ThemeColor = xlThemeColorAccent1 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
    End With 
End With 

'STORING DATA IN TABLEDESTINATION VARIABLE 
'25,000 rows 
TableSource = wsSource.Range("A4:AX25003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'50,000 rows 
TableSource = wsSource.Range("A25004:AX50003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'75,000 rows 
TableSource = wsSource.Range("A50004:AX75003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'100,000 rows 
TableSource = wsSource.Range("A75004:AX100003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'125,000 rows 
TableSource = wsSource.Range("A100004:AX125003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'150,000 rows 
TableSource = wsSource.Range("A125004:AX150003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'175,000 rows 
TableSource = wsSource.Range("A150004:AX175003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'200,000 rows 
TableSource = wsSource.Range("A175004:AX200003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'225,000 rows 
TableSource = wsSource.Range("A200004:AX225003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'250,000 rows 
TableSource = wsSource.Range("A225004:AX250003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'275,000 rows 
TableSource = wsSource.Range("A250004:AX275003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'300,000 rows 
TableSource = wsSource.Range("A275004:AX300003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'325,000 rows 
TableSource = wsSource.Range("A300004:AX325003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'350,000 rows 
TableSource = wsSource.Range("A325004:AX350003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'375,000 rows 
TableSource = wsSource.Range("A350004:AX375003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'400,000 rows 
TableSource = wsSource.Range("A375004:AX400003") 'First row and column numbers are 1 and not 0 
Call LoopRetrieveDefaultData(RowCountSource, TableSource, TableCoreID, ColumnCountDestination, TableDestination, RowCountDestination) 

'PASTING DATA IN SHEET DESTINATION AND FORMATTING 
'Paste TableSource 
wsDestination.Range("A4:AX50004") = TableDestination 

'Format pasted area 
wsDestination.Select 'The sheet must be activated 
wsDestination.Range("A4:AX50004").Select 
Call TableRows 

wsDestination.Cells.HorizontalAlignment = xlLeft 

'Empty memory 
Erase TableSource 
Erase TableDestination 
Erase TableCoreID 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

End Sub 

Sub LoopRetrieveDefaultData(RowCountSource As Long, TableSource As Variant, TableCoreID As Variant, ColumnCountDestination As Byte, TableDestination As Variant, RowCountDestination As Long) 

For RowCountSource = 1 To 25000 
    If IsError(Application.Match(TableSource(RowCountSource, 2), TableCoreID, 0)) = False Then 'Comparing Core ID. The 
    'column number is 2 and not 1 because the first column of the table is 1 
    'from TableSource (Arrow Bar data) to list of defaults Core ID(TableCoreID) 
    For ColumnCountDestination = 0 To 49 'Paste correponding row in TableDestination 
     TableDestination(RowCountDestination, ColumnCountDestination) = TableSource(RowCountSource, ColumnCountDestination + 1) 
    Next ColumnCountDestination 
    RowCountDestination = RowCountDestination + 1 
    End If 
Next RowCountSource 
End Sub