Процедура слишком большая ошибка при передаче большого количества именованных диапазонов

Question

Мне нужно импортировать большой набор данных из одной книги Excel в другую. Я не могу использовать запросы или любое другое соединение для передачи данных. Дело в том, что столбцы (число и порядок) со временем меняются.

Итак, я определил имена для 206 столбцов исходной книги в VBA (Dim xyz_Source As Long). Затем я ищу местоположения этих 206 столбцов (xyz_Source = Application.WorksheetFunction.Match("xyz", Source.Range, 0)) и создаю диапазон (Source.Range(Cells(2, xyz_Source), Cells(LastRow, xyz_Source).

После этого я делаю то же самое для целевого файла (Dim xyz_Target As Long & xyz_Target = Application.WorksheetFunction.Match("xyz", Target.Range, 0)) и помещаю его вместе как range.

В конце концов, я копирую их по отдельности и вставляю в целевой файл (также по отдельности), по одному за раз.

Это в основном создает целую книгу кода для этой простой процедуры. И Excel проходит через «слишком большую процедуру» в ответ.

Знаете ли вы какой-нибудь разумный способ сокращения кода / циклического прохождения / передачи сторонних компонентов другим модулям; то есть сделать это более умным?

Любой совет действительно ценится. Большое спасибо заранее!

Вот пример / выдержка из моего кода:

Dim Column_Name_1_Source As Long
Dim Column_Name_2_Source As Long
Dim Column_Name_3_Source As Long
Dim Column_Name_4_Source As Long
Dim Column_Name_5_Source As Long
Dim Column_Name_6_Source As Long
Dim Column_Name_7_Source As Long
Dim Column_Name_8_Source As Long
Dim Column_Name_9_Source As Long
Dim Column_Name_10_Source As Long

Column_Name_1_Source = Application.WorksheetFunction.Match("Column Name 1", Source.Range("10:10"), 0)
Column_Name_2_Source = Application.WorksheetFunction.Match("Column Name 2", Source.Range("10:10"), 0)
Column_Name_3_Source = Application.WorksheetFunction.Match("Column Name 3", Source.Range("10:10"), 0)
Column_Name_4_Source = Application.WorksheetFunction.Match("Column Name 4", Source.Range("10:10"), 0)
Column_Name_5_Source = Application.WorksheetFunction.Match("Column Name 5", Source.Range("10:10"), 0)
Column_Name_6_Source = Application.WorksheetFunction.Match("Column Name 6", Source.Range("10:10"), 0)
Column_Name_7_Source = Application.WorksheetFunction.Match("Column Name 7", Source.Range("10:10"), 0)
Column_Name_8_Source = Application.WorksheetFunction.Match("Column Name 8", Source.Range("10:10"), 0)
Column_Name_9_Source = Application.WorksheetFunction.Match("Column Name 9", Source.Range("10:10"), 0)
Column_Name_10_Source = Application.WorksheetFunction.Match("Column Name 10", Source.Range("10:10"), 0)

Dim Column_Name_1_Target As Long
Dim Column_Name_2_Target As Long
Dim Column_Name_3_Target As Long
Dim Column_Name_4_Target As Long
Dim Column_Name_5_Target As Long
Dim Column_Name_6_Target As Long
Dim Column_Name_7_Target As Long
Dim Column_Name_8_Target As Long
Dim Column_Name_9_Target As Long
Dim Column_Name_10_Target As Long

Column_Name_1_Target = Application.WorksheetFunction.Match("Column Name 1", Target.Range("9:9"), 0)
Column_Name_2_Target = Application.WorksheetFunction.Match("Column Name 2", Target.Range("9:9"), 0)
Column_Name_3_Target = Application.WorksheetFunction.Match("Column Name 3", Target.Range("9:9"), 0)
Column_Name_4_Target = Application.WorksheetFunction.Match("Column Name 4", Target.Range("9:9"), 0)
Column_Name_5_Target = Application.WorksheetFunction.Match("Column Name 5", Target.Range("9:9"), 0)
Column_Name_6_Target = Application.WorksheetFunction.Match("Column Name 6", Target.Range("9:9"), 0)
Column_Name_7_Target = Application.WorksheetFunction.Match("Column Name 7", Target.Range("9:9"), 0)
Column_Name_8_Target = Application.WorksheetFunction.Match("Column Name 8", Target.Range("9:9"), 0)
Column_Name_9_Target = Application.WorksheetFunction.Match("Column Name 9", Target.Range("9:9"), 0)
Column_Name_10_Target = Application.WorksheetFunction.Match("Column Name 10", Target.Range("9:9"), 0)

‘Column_Name_1:
Source.Range(Cells(11, Column_Name_1_Source), Cells(Lastrow_Source, Column_Name_1_Source)).SpecialCells(xlCellTypeVisible).Copy
Target.Range(Cells(10, Column_Name_1_Target), Cells(Lastrow_Ziel, Column_Name_1_Target)).PasteSpecial xlPasteValues
‘Column_Name_2:
Source.Range(Cells(11, Column_Name_2_Source), Cells(Lastrow_Source, Column_Name_2_Source)).SpecialCells(xlCellTypeVisible).Copy
Target.Range(Cells(10, Column_Name_2_Target), Cells(Lastrow_Ziel, Column_Name_2_Target)).PasteSpecial xlPasteValues
‘Column_Name_3:
Source.Range(Cells(11, Column_Name_3_Source), Cells(Lastrow_Source, Column_Name_3_Source)).SpecialCells(xlCellTypeVisible).Copy
Target.Range(Cells(10, Column_Name_3_Target), Cells(Lastrow_Ziel, Column_Name_3_Target)).PasteSpecial xlPasteValues
‘Column_Name_4:
Source.Range(Cells(11, Column_Name_4_Source), Cells(Lastrow_Source, Column_Name_4_Source)).SpecialCells(xlCellTypeVisible).Copy
Target.Range(Cells(10, Column_Name_4_Target), Cells(Lastrow_Ziel, Column_Name_4_Target)).PasteSpecial xlPasteValues
‘Column_Name_5:
Source.Range(Cells(11, Column_Name_5_Source), Cells(Lastrow_Source, Column_Name_5_Source)).SpecialCells(xlCellTypeVisible).Copy
Target.Range(Cells(10, Column_Name_5_Target), Cells(Lastrow_Ziel, Column_Name_5_Target)).PasteSpecial xlPasteValues
‘Column_Name_6:
Source.Range(Cells(11, Column_Name_6_Source), Cells(Lastrow_Source, Column_Name_6_Source)).SpecialCells(xlCellTypeVisible).Copy
Target.Range(Cells(10, Column_Name_6_Target), Cells(Lastrow_Ziel, Column_Name_6_Target)).PasteSpecial xlPasteValues
‘Column_Name_7:
Source.Range(Cells(11, Column_Name_7_Source), Cells(Lastrow_Source, Column_Name_7_Source)).SpecialCells(xlCellTypeVisible).Copy
Target.Range(Cells(10, Column_Name_7_Target), Cells(Lastrow_Ziel, Column_Name_7_Target)).PasteSpecial xlPasteValues
‘Column_Name_8:
Source.Range(Cells(11, Column_Name_8_Source), Cells(Lastrow_Source, Column_Name_8_Source)).SpecialCells(xlCellTypeVisible).Copy
Target.Range(Cells(10, Column_Name_8_Target), Cells(Lastrow_Ziel, Column_Name_8_Target)).PasteSpecial xlPasteValues
‘Column_Name_9:
Source.Range(Cells(11, Column_Name_9_Source), Cells(Lastrow_Source, Column_Name_9_Source)).SpecialCells(xlCellTypeVisible).Copy
Target.Range(Cells(10, Column_Name_9_Target), Cells(Lastrow_Ziel, Column_Name_9_Target)).PasteSpecial xlPasteValues
‘Column_Name_10:
Source.Range(Cells(11, Column_Name_10_Source), Cells(Lastrow_Source, Column_Name_10_Source)).SpecialCells(xlCellTypeVisible).Copy
Target.Range(Cells(10, Column_Name_10_Target), Cells(Lastrow_Ziel, Column_Name_10_Target)).PasteSpecial xlPasteValues

Новый код с циклом (все еще с ошибками):

Dim colname_Target As Variant
Dim colnum_Target As Variant
Dim colnum_Source As Variant
Dim i_Target As Long
Dim Unique_ID_Target As Long

Unique_ID_Target = Application.WorksheetFunction.Match("Unique Identifier", Target.Range("9:9"), 0)
colname_Target = Application.Transpose(Application.Transpose(Target.Range(Cells(9, 1).Address, Cells(9, Unique_ID_Target - 1).Address).Value2))

ReDim colnum_Target(Unique_ID_Target)
ReDim colnum_Source(Unique_ID_Target)

For i_Target = LBound(colname_Target) To UBound(colname_Target) Step 1
    colnum_Target(i_Target) = Target.Rows(9).Find(What:=colname_Target(i_Target), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Next i_Target

For i_Target = LBound(colname_Target) To UBound(colname_Target) Step 1
    colnum_Source(i_Target) = Source.Rows(10).Find(What:=colname_Target(i_Target), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Next i_Target

Answer 1

После нескольких изменений в коде @Cyril этот код отлично работает:

Dim i As Long, destcolname As Variant, srccolnum As Variant, lrd As Long, lcd As Long, lrs As Long, r As Long, c As Long

With Sheets("destination")
    lrd = .Cells(.Rows.Count, 1).End(xlUp).Row
    lcd = .cells(11,.columns.count).end(xltoleft).column
    destcolname = Application.Transpose(.Range(.Cells(9, 1), .Cells(9, lcd)).Value)

End With
With Sheets("Source")
    ReDim srccolnum(lcd, 1)
    For i = 1 To lcd
    On Error Resume Next
        srccolnum(i, 1) = .Rows(10).Find(What:=destcolname(i, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    Next i
End With

With Sheets("destination")
    lrs = Sheets("Source").Cells(.Rows.Count, 1).End(xlUp).Row
    For r = 11 To lrs
        lrd = Sheets("destination").Cells(.Rows.Count, 1).End(xlUp).Row
        For c = 1 To lcd
            Sheets("destination").Cells(lrd + 1, c).Value = Sheets("Source").Cells(r, srccolnum(c, 1)).Value
        Next c
    Next r
End With

Еще раз спасибо, @Cyril!

Answer 2

Пример моего комментария (не проверено):

dim colname as variant, colnum as variant, i as long
colname = array("colA","colB","colC")
redim colnum(3)
for i = lbound(colname) to ubound(colname) step 1
    on error goto moo
    colnum(i) = Rows(11).Find(What:=colname(i), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
next i
for i = lbound(colnum) to ubound(colnum) step 1
    if colnum(i) > 0 then
        'use the data with cells(row,col)
    end if
next i
'on error
moo:
    colnum(i) = 0

---

Edit1: Добавит некоторую информацию об использовании ...

Если у вас есть желаемый вывод, используйте его при определении массива заголовков столбцов, поэтому, когда вы проходите этот цикл (второй цикл), вы можете сделать что-то вроде:

destination.cells(lastrow+1,i).value = source.cells(31,colnum(i)).value

Использование значения = значение в сравнении с копированием / вставкой также помогает в скорости.

---

Edit2:

Попробуем использовать ваш код и обновить несколько вещей, если это поможет

Dim colname_Target As Variant
Dim colnum_Target As Variant
Dim colnum_Source As Variant
Dim i_Target As Long
Dim Unique_ID_Target As Long

Unique_ID_Target = Application.Match("Unique Identifier", Target.Range("9:9"), 0) - 1 'added -1 so you don't have to put it in other places
'array for column names
colname_Target = Range(Cells(9, 1), Cells(9, Unique_ID_Target)).Value2

'sets each array equivalent size to colname...   
ReDim colnum_Target(Unique_ID_Target)
ReDim colnum_Source(Unique_ID_Target)

'this loop populates the array colnum_target, using the values of colname_target    
For i_Target = LBound(colname_Target) To UBound(colname_Target) Step 1
    colnum_Target(i_Target) = Rows(9).Find(What:=colname_Target(i_Target), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Next i_Target

'this loop populates the array colnum_source, using the values of colname_target          
For i_Target = LBound(colname_Target) To UBound(colname_Target) Step 1
    colnum_Source(i_Target) = Source.Rows(10).Find(What:=colname_Target(i_Target), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Next i_Target

Одна вещь, которую нужно сказать после просмотра вашего кода ... попробуйте использовать Dest или что-то иное, чем Target, так как Target определен в VBA и регулярно используется для Change_Events. Я так понимаю, вы используете переменные, такие как Target = Sheets ("Destination") и Source = Sheets ("Source")? Это по крайней мере мой вывод. Мой комментарий об использовании Target был основан на использовании "Target" VBA, извините за то, что до сих пор не перехватил ссылку на источник для листа / книги.

Я скажу, что я запутался, почему у вас есть второй массив для colname / colnum. Предполагаемое намерение состояло в том, чтобы использовать целевой порядок столбцов для создания массива столбцов с теми же именами заголовков, что и в исходном документе, в случае, если они имеют другой порядок. Таким образом, вы сможете выполнить цикл от начала до конца (от столбца 1 до последнего столбца) на листе назначения и вводить данные из источника, например:

dest.cells(lastrowdest+1,i).value = source.cells(r,colnum(i)).value
i = i+1

После того, как у вас есть массив, вы можете использовать данные массива так, чтобы (это использовало ваши 2 массива, хотя можно сделать только с 1 массивом для исходных данных):

For r = 11 to lrs 'lrs is last row source, starting on 11, as it looks like your headers are in 10
    lrd = Dest.Cells(Dest.Rows.Count,1).End(xlup).row
    Dest.Cells(lrd+1,colnum_target(j)).value = Source.Cells(r,colnum_source(j))
    j = j+1
Next r

---

Edit3:

Попытается сократить мои мысли до одного куска кода, используя ваши данные (но из-за соглашений об именах будет использовать Dest для назначения, а не Target):

dim i as long, destcolname as variant, srccolnum as variant, lrd as long, lcd as long, lrs as long, r as long, c as long
with sheets("destination")
    lrd = .cells(.rows.count,1).end(xlup).row
    lcd = .cells(11,.columns.count).end(xltoleft).column
    destcolname = .range(.cells(11,1),.cells(11,lcd)).value
end with
with sheets("source")
    redim srccolnum(1,lcd)
    for i = 1 to lcd 
        srccolnum(1,i) = .rows(9).Find(What:=destcolname(1,i), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    next i
    lrs = .cells(.rows.count,1).end(xlup).row
    for r = 10 to lrs
        lrd = sheets("destination").cells(sheets("destination").rows.count,1).end(xlup).row
        for c = 1 to lcd
            sheets("destination").cells(lrd+1,c).value = .cells(r,srccolnum(1,c)).value
        next c
    next r
end with

Что-то подобное должно работать? не проверял, просто сделал это с головы