Файл Excel становится слишком тяжелым после добавления процедуры VBA (извлечения данных из других листов)

Question

Я работаю над автоматизацией модели Excel путем копирования данных из других листов в мастер-файл. У меня есть небольшая проблема, что после добавления кода файл изменился с 25 МБ до 60 МБ, без изменения содержимого, только с добавлением кода. Ниже вы можете найти фрагмент того, как я автоматизировал импорт

Sub copytest() 'Procedure for retrieving data from the sourcefiles

    Dim wbTarget, wbSource As Workbook
    Dim target As Object
    Dim pathSource, fileName As String
    Dim xlApp As Application
    Dim lastRow As Long

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    'path where the data source folders are located (please keep all of them in the same directory)
    pathSource = "C:\Users\vferraz\Desktop\crm stock\RAPOARTE IMPORTANTE\18.02\Rapoarte pentru Handsets\"
    Set wbTarget = ThisWorkbook

    Set xlApp = CreateObject("Excel.Application")
    xlApp.DisplayAlerts = False
    Application.CutCopyMode = False

    'Stock 0001
    Set wbSource = xlApp.Workbooks.Open(pathSource & "Stoc 0001.xls")
    wbSource.Sheets(1).UsedRange.Copy
    wbSource.Close
    Set target = wbTarget.Sheets("Stock 0001")
    target.UsedRange.Clear
    Range("A1").Select
    target.Paste

    xlApp.Quit
    Set wbSource = Nothing
    Set xlApp = Nothing

    ThisWorkbook.Sheets("Mastersheet").Activate

    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

В приведенном выше фрагменте я добавил только разбор одного файла (Stock 0001), но тот же метод сделан для других 10-15 файлов.

У кого-нибудь есть идеи по улучшению эффективности / размера этого файла на основе этой процедуры?

P.S. Я знаю, что метод «Вставить» может добавлять форматы, а не только значения, затем я попытался добавить .PasteSpecial xlPasteValues вместо вставки, но в конечном итоге выдает ошибки, которые я не смог определить

Обновление:

На основе этого решения, это новая версия, которую я пробовал:

Stock 0001
    Set wbSource = xlApp.Workbooks.Open(pathSource & "Stoc 0001.xls")
    lastRow = wbSource.Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    wbTarget.Sheets("Stock 0001").Cells.Clear
    wbSource.Sheets(1).Range("A1:C" & lastRow).Copy Destination:=wbTarget.Sheets("Stock 0001").Range("A1")
    wbSource.Clo

Строка wbSource.Sheets(1).Range("A1:C" & lastRow).Copy Destination:=wbTarget.Sheets("Stock 0001").Range("A1" Выдает «метод копирования класса диапазона с ошибкой.

Answer 1

Вместо этого

'Stock 0001
Set wbSource = xlApp.Workbooks.Open(pathSource & "Stoc 0001.xls")
wbSource.Sheets(1).UsedRange.Copy
wbSource.Close
Set target = wbTarget.Sheets("Stock 0001")
target.UsedRange.Clear
Range("A1").Select
target.Paste

Попробуйте это

wbSource.Sheets(1).Columns("").Copy Destination:=wbTarget.Sheets("Stock 0001").Range("A1")

Куда я положил Columns, просто замените его на любой диапазон, который вы используете через Range() или Cells и т. д. Копирование и вставка занимает некоторое время, и возникают проблемы, если вы уже копируете что-либо в другом месте.Это просто берет данные за вас

Кроме того, этот фрагмент кода будет вашим другом навсегда

With Sheets("Sheet1")
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With

Это находит нижний ряд столбца A (или любой другой ваш "всегда заполненный" столбец)будет

Sub LastRow()

    Dim wb As Workbook, ws As Worksheet, LastRow As Long

    Set wb = ThisWorkbook
    Set ws = Worksheets("Data")

    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    With ws.Range(ws.Cells(2, 13), ws.Cells(LastRow, 13))
        'This is Range M2:M(bottom)
        .
        .
        'etc
        .
    End With

End Sub

Изменить .... 3:

Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
Application.CutCopyMode = False

'Stock 0001
Set wbSource = xlApp.Workbooks.Open(pathSource & "Stock 0001.xls")

Вместо всего этого, пожалуйста, используйте

Set wbSource = Workbooks.Open(pathSource & "Stock 0001.xls")

Answer 2

Вам также нужна обработка ошибок в вашем коде.Когда он разрывается (файл не существует, путь недействителен, лист не существует) между

Application.EnableEvents = False
Application.ScreenUpdating = False

и

Application.EnableEvents = True
Application.ScreenUpdating = True

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

On Error GoTo ExitErr
    Application.EnableEvents = False
    Application.ScreenUpdating = False

Тогда после вашего кода вы должны иметь

ExitErr:
    Application.EnableEvents = True
    Application.ScreenUpdating = True

Answer 3

Я нашел способ уменьшить размер файла до прежнего уровня, добавив следующую строку к импорту после команды paste

target.Cells.ClearFormats

В этом случае форматы взяты изданные были очищены.