Question

首先是一个小背景：我需要一个脚本来在我选择的目录中获取 n CSV文件，然后使用 n 标签。我还需要脚本自动为选项卡命名一些有用的东西。

我弗兰肯斯坦使用宏观录音，我在这里发现的作品和好的“老式谷歌搜索”一起编写了一个剧本。它运行时没有太多错误;但是，在流程结束时（如果有10个以上的CSV文件），它会慢慢减慢。

我尝试了几个不同的版本，确保清除剪贴板，关闭当前正在复制的文件，禁止主文件的打开和关闭动画等。到目前为止，唯一成功的事情是成功的是（我觉得有用）清理剪贴板。

我承认这是我第一次尝试使用Visual Basic，而且我不是专业的程序员，因此代码可能无法正确处理内存。

我的问题是：您是否可以发现正在减慢代码的部分/操作？或至少提供一个可行的解释，为什么会发生？一般来说，我的笔记本电脑并不吝啬。这是一款带有i5处理器和8GB内存的HP EliteBook，所以我无法想象这是一个资源问题。

我已经清理了代码和对个人目录的任何引用，并将其发布在下面。

提前感谢您的帮助。

Sub MultiCSV_to_Tabs()
Dim vaFiles As Variant
Dim i As Long
Dim wbkToCopy As Workbook
Dim wbkToPaste As Workbook

vaFiles = Application.GetOpenFilename("CSV Files (*.csv), *.csv", _
          Title:="Select files", MultiSelect:=True)

'User_Created_File = "PLACE YOUR DIRECTORY AND FILE NAME IN BETWEEN THESE QUOTATION MARKS"

If IsArray(vaFiles) Then
    For i = LBound(vaFiles) To UBound(vaFiles)

        'Open the first CSV file in the list of selections
        Set wbkToCopy = Workbooks.Open(Filename:=vaFiles(i))

        'Split the vaFiles variable on backslashes to dissect the PathName and FileName
        SplitFileName = Split(vaFiles(i), "\")

        'Go find the last entry in the SplitFileName variable. This should be the exported file name we selected.
        ExportedCSVFileName = SplitFileName(UBound(SplitFileName))

        'Select all cells and copy that selection
        wbkToCopy.Application.DisplayAlerts = False
        Cells.Select
        Selection.Copy

        'Close the current workbook without saving changes
        wbkToCopy.Close savechanges:=False

        'Open the summary workbook
        Set wbkToPaste = Workbooks.Open(User_Created_File)

        'Add a new tab to the end of the last tab
        Sheets.Add After:=Sheets(Sheets.Count)

        'Define new sheetname using the parsed filename from the workbook
        shtname = Mid(ExportedCSVFileName, 17, 25)
        ActiveSheet.Name = shtname

        'Paste the selection we copied earlier
        wbkToPaste.Application.DisplayAlerts = False
        ActiveSheet.Paste

        wbkToPaste.Application.CutCopyMode = False

        'Close the summary workbook and save the changes. Go to the next file in the array.
        wbkToPaste.Close savechanges:=True

    Next i

End If

Set wbkToCleanUp = Workbooks.Open(User_Created_File)
Sheets("Sheet1").Delete
wbkToCleanUp.Close savechanges:=True
MsgBox ("Copy/Paste complete")

End Sub

Answer 1

Cells.Select占用了大量内存。找到工作表的实际范围并复制它。

对于示例

Sub Sample()
    Dim ws As Worksheet
    Dim Lrow As Long, LCol As Long
    Dim rng As Range

    Set ws = Sheet1

    With ws
        '~~> Find Last row which has data
        Lrow = .Cells.Find(What:="*", _
                After:=wks.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

        '~~> Find Last column which has data                    
        LCol = .Cells.Find(What:="*", _
                After:=wks.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Column

        Set rng = .Range("A1:" & Split(Cells(, LCol).address, "$")(1) & Lrow)

        rng.Copy

        '~~> Paste where you want
    End With
End Sub

在粘贴文件之前，也不要关闭文件。粘贴时也要小心。在粘贴之前将Copy命令放在一行。有时剪贴板会清除，您可能会遇到问题。

你能找到导致我的Excel VB脚本变慢的原因吗？

1 个答案: