代码之家 › 专栏 › 技术社区 › vferraz

添加VBA(从其他工作表中提取数据)例程后,Excel文件变得太重

vba excel

0

vferraz · 技术社区 · 6 年前

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

有没有人有任何想法来提高这个文件的效率/大小?

P、我意识到“粘贴”方法可能是添加格式而不是只添加值,然后我尝试添加 .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" 抛出“范围类的复制方法失败错误。

1 回复 | 直到 6 年前

1

2

Badja 6 年前

'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

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

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")

2

1

Frank Ball 6 年前

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

3

0

vferraz 6 年前

我找到了一种方法,通过在 paste

target.Cells.ClearFormats