Есть лист в нём есть шапка.
Есть другой лист в нём есть данные.
Так вот задача состоит в том чтобы данные из 2-го листа вставить в 1-ый после шапки с заданным для них форматированием колонок.
Я для этого сделал вот как:
- Код: Выделить всё
Sub dbf_import()
Dim cnt, n, num, dnum As Integer
'Очистка
Worksheets("dbf").Range("a:a:af:af").Clear
Worksheets("dbf").Activate
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\Gb\;Mode=Share Deny Write;Extended Properties="""";Jet O" _
, _
"LEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=18;Jet OLEDB:Database Lo" _
, _
"cking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLE" _
, _
"DB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact " _
, "Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination:=Range("A1" _
))
.CommandType = xlCmdTable
.CommandText = Array("123")
.Name = "123"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "C:\Gb\123.dbf"
.Refresh BackgroundQuery:=False
End With
cnt = Worksheets("Паспорт участка").Cells(1, 1).Value
n = 1
num = 26
dnum = 2
Worksheets("Паспорт участка").Activate
With ActiveSheet
Do While Not n = cnt
.Rows(num).Copy
' Вставляю строку в следующую строку
.Rows(num).Insert
Worksheets("Паспорт участка").Cells(num, 2) = Worksheets("dbf").Cells(dnum, 1)
Worksheets("Паспорт участка").Cells(num, 3) = Worksheets("dbf").Cells(dnum, 2)
Worksheets("Паспорт участка").Cells(num, 6) = Worksheets("dbf").Cells(dnum, 3)
Worksheets("Паспорт участка").Cells(num, 11) = Worksheets("dbf").Cells(dnum, 4)
Worksheets("Паспорт участка").Cells(num, 19) = Worksheets("dbf").Cells(dnum, 5)
''Worksheets("Паспорт участка").Cells(num, 21) = Worksheets("dbf").Cells(dnum, 6)
Worksheets("Паспорт участка").Cells(num, 24) = Worksheets("dbf").Cells(dnum, 7)
n = n + 1
num = num + 1
dnum = dnum + 1
Loop
Application.CutCopyMode = False
End With
End Sub
Но я вставляю построчно в цикле. Из-за этого при работе допустим с массивом в 200 записей вставка происходит около 8 секунд.
Несложно посчитать что допустим при 15000 записей на другом листе вставка будет происходить около 10 минут.
Так вот, поэтому хочу построковую вставку в цикле заменить вставкой range`a
для этого я пробовал вместо построковой вставки делать вот так:
- Код: Выделить всё
Worksheets("dbf").Range("$A:$AF").Copy _
Destination:=Worksheets("Паспорт участка").Range("$A:$AF")
Он всё вставляет но естественно затирает шапку, так как вставляет весь массив $A:$AF в лист "Паспорт участка".
Чтобы не вставлять весь массив я делал так, без затирания шапки
- Код: Выделить всё
Worksheets("dbf").Range("A1:AF200").Copy _
Destination:=Worksheets("Паспорт участка").Range("A26")
И впринципе меня это устраивает.
Но тогда возникает другой вопрос...
Я не знаю точную высоту(кол-во записей в массиве) копируемого массива в примере выше он равен 200. А вообще его длинна различна. У меня есть переменная cnt
(в самом верхнем коде) в которой хранится высота массива (кол-во записей в массиве). Так вот у меня вопрос как правильно эту переменную поставить вместо цифры 200 в коде
- Код: Выделить всё
Worksheets("dbf").Range("A1:AF[b]200[/b]").Copy _
Destination:=Worksheets("Паспорт участка").Range("A26")
Чтобы бралось значение переменной а соотвественно и массив нужной высоты.
Зараннее благодарен за помощь.
и вырежу весь код из всех твоих постов.