Question

我正在通过VBA开展电子表格自动化流程并且迄今为止取得了成功，但我有点坚持使用它的一个元素，即在复制之前清除过滤器。这段代码位于masterfile上的一个模块中，它所做的是打开文件夹中的每个工作簿（每个文件都有一个工作表），将所有数据从A2复制到AJ（不管有多少行），将其粘贴到masterfile，然后关闭文件并移动到文件夹中的下一个文件，直到所有文件都合并到主文件中，一个数据块直接在前一个文件下面。它完美地运作。问题是，在某些情况下，这些文件可能具有过滤列，并且不会复制过滤掉的所有内容。这些文件是从另一个部门发送的。我搜索了SO并找到了不同的方法来清除过滤器，我甚至尝试了一个独立工作的代码，但我不能因为某些原因让它们在我的代码上运行，也许我将它们放在错误的地方或什么？另外，有什么我应该改变来清理/优化代码吗？

感谢您的时间和关注！

Option Explicit

Sub ExcelMerge()
    Dim wbkReports As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set mergeObj = CreateObject("Scripting.FileSystemObject")

    Set dirObj = mergeObj.Getfolder("C:\Users\Report")
    Set filesObj = dirObj.Files
For Each everyObj In filesObj
    Set wbkReports = Workbooks.Open(everyObj)

    Range("A2:AJ" & Range("A65536").End(xlUp).Row).Copy

    ThisWorkbook.Worksheets(1).Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wbkReports.Close
Next

    AddFormulas

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub AddFormulas()
    Dim lastRow As Long, i As Long
    Dim ws As Worksheet

    Set ws = Sheets("Report")

    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

With ws
    For i = 10 To lastRow
        If Len(Trim(.Range("A" & i).Value)) <> 0 Then _
        .Range("AK" & i).FormulaR1C1 = "formula here"
        .Range("AL" & i).FormulaR1C1 = "formula here"
        .Range("AM" & i).FormulaR1C1 = "formula here"
    Next i
End With
End Sub

Answer 1

看看这个。此外，您应该定义您正在使用的工作表而不是仅从Range("A2:AJ...进行复制，因为这可能会导致从错误的工作表复制数据时出错。此外，如果您在关闭工作簿时添加SaveChanges:=False，则会阻止对范围进行不过滤的永久性

Sub ExcelMerge()
    Dim wbkReports As Workbook
    Dim ws As Worksheet
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set mergeObj = CreateObject("Scripting.FileSystemObject")

    Set dirObj = mergeObj.Getfolder("C:\Users\Report")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        Set wbkReports = Workbooks.Open(everyObj)

        For Each ws In wbkReports.Worksheets
            If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData
        Next ws

        Range("A2:AJ" & Range("A65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(1).Activate
        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
        ' Include savechanges:=False to not save the unfiltering of sheets
        wbkReports.Close savechanges:=False
    Next

    AddFormulas

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

VBA在合并文件之前清除过滤器

1 个答案: