Question

我正在通过将其他工作表中的数据复制到主文件中来自动化excel模型。我有一个问题，在添加代码后，文件从25mb变为60mb，而不更改内容，仅添加代码。您可以在下面找到我如何自动导入的代码段

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

在上面的代码段中，我仅添加了一个文件（股票0001）的解析，但是对其他10-15个文件也执行了相同的方法。

有人基于此过程有任何想法来提高此文件的效率/大小吗？

P.S。我意识到“粘贴”方法可能只是添加格式，而不是仅添加值，然后我尝试添加.PasteSpecial xlPasteValues而不是粘贴，但最终会引发我无法识别的错误

更新：

基于this解决方案，这是我尝试的新版本：

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

在这种情况下，将清除从数据中获取的格式。

添加VBA（从其他工作表中提取数据）例程后，Excel文件变得过重

3 个答案: