Question

我有4个宏一个接一个地运行：

1st - 查找源文件位置中的最新（最新）文件：在这里我遇到了问题，因为如果该位置没有文件（C：\ Source File）那么，该文件是当前打开（主文件）的格式是只有源文件应该是这样的。我不需要消息框，如果没有源，我不希望格式化这个（主）文件该位置的数据文件。

'1
Option Explicit

Sub OpenLatestFile()
Application.ScreenUpdating = False
    Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim LMD As Date
    MyPath = "C:\Source File\"
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    MyFile = Dir(MyPath & "*.csv", vbNormal)
    If Len(MyFile) = 0 Then
        MsgBox "No files were found...", vbExclamation
        Exit Sub
    End If
    Do While Len(MyFile) > 0
        LMD = FileDateTime(MyPath & MyFile)
        If LMD > LatestDate Then
            LatestFile = MyFile
            LatestDate = LMD
        End If
        MyFile = Dir
    Loop
    Workbooks.Open MyPath & LatestFile
Application.ScreenUpdating = True
End Sub

第二个宏：删除列

'2
Sub RemoveCols()
Application.ScreenUpdating = False
Alfa1 = ActiveWorkbook.Name
Range("X:AA,FA:I").Delete
Application.ScreenUpdating = True
End Sub

第3行：删除行

'3
Sub RemoveXYZ()
Application.ScreenUpdating = False
    Dim lLRow As Long
    With Sheets(1)
        lLRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("C:C").AutoFilter Field:=1, Criteria1:="XYZ"
        .Range("C2:C" & lLRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete xlShiftUp
        .AutoFilterMode = False
    End With
Application.ScreenUpdating = True
End Sub

第4步：将源文件中的格式化数据复制到主文件（其中包含宏）

'4
Option Explicit

    Sub TransferData()
Application.ScreenUpdating = False
    Dim Last_Row1 As Long, Last_Row2 As Long
    Dim WB1 As Workbook, WB2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set WB1 = ActiveWorkbook
    Set ws1 = WB1.Sheets(1)
    Set WB2 = Workbooks("MainFile.xlsm")
    Set ws2 = WB2.Sheets("Master")
    Last_Row1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    Last_Row2 = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
    ws1.Range("A2:Z" & Last_Row1).Copy ws2.Range("A" & Last_Row2)
    WB2.Save
    Application.Quit
Application.DisplayAlerts = False
    WB1.SaveChanges = False
    WB2.Save
Application.DisplayAlerts = True
Application.ScreenUpdating = True
    End Sub

您能否告知如何最大限度地提高上述代码的效率，如果“源文件夹”中没有数据，请确保主文件未被格式化？

此外，第一个宏正在寻找最新的文件（我想确保它不会从前一天拿起文件） - 任何想法如何添加命令“不要打开源数据，如果日期是“从今天起减1”？

由于西

Answer 1

我合并了所有4个宏并清理了几个。最大的变化是提前设置工作簿和工作表，以便更容易引用。

宏2是否会影响源文件或主文件？如果每个宏一个接一个地运行，那么它似乎是源文件，这就是我在下面的代码中所做的。如果这是错误的，您需要将.Range("X:AA,FA:I").Delete移出With WS1块并将其更改为WS2.Range("X:AA,FA:I").Delete。

如您所见，代码的第一部分几乎完全相同。首次分配MyFile时，如果目录中没有.csv文件，则它将是一个零长度字符串。然后代码测试MyFile实际上是否为零长度字符串：If Len(MyFile) > 0 Then。因此，如果MyPath中不存在.csv文件，则执行If语句并运行Exit Sub，这将停止执行该过程。因为代码全部在一个子中，所以如果文件夹为空，格式代码将不会运行。

为了使这项工作，你需要停止对宏2-4的调用，并用下面的代码替换宏1。

Option Explicit

Sub ProcessLatestFile()

    Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim LMD As Date
    Dim lLRow As Long
    Dim Last_Row1 As Long, Last_Row2 As Long
    Dim WB1 As Workbook, WB2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet

    Application.ScreenUpdating = False

    'Check for file
    MyPath = "C:\Source File\"
    MyFile = Dir(MyPath & "*.csv", vbNormal)
    If Len(MyFile) = 0 Then
        MsgBox "No files were found...", vbExclamation
        Exit Sub
    End If
    Do While Len(MyFile) > 0
        LMD = FileDateTime(MyPath & MyFile)
        If LMD > LatestDate Then
            LatestFile = MyFile
            LatestDate = LMD
        End If
        MyFile = Dir
    Loop

    'Open Source File
    Set WB1 = Workbooks.Open(MyPath & LatestFile)
    Set ws1 = WB1.Sheets(1)
    Set WB2 = Workbooks("MainFile.xlsm")
    Set ws2 = WB2.Sheets("Master")

    'Format Source File
    With WS1
        .Range("X:AA,FA:I").Delete
        lLRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("C:C").AutoFilter Field:=1, Criteria1:="XYZ"
        .Range("C1:C" & lLRow).Offset(1,0).SpecialCells(xlCellTypeVisible).EntireRow.Delete xlShiftUp
        .AutoFilterMode = False
    End With

    'Copy data
    Last_Row1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    Last_Row2 = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
    ws1.Range("A2:Z" & Last_Row1).Copy ws2.Range("A" & Last_Row2)

    'Clean Up
    Application.DisplayAlerts = False
    WB1.SaveChanges = False
    WB2.Save
    Application.DisplayAlerts = True
    Application.Quit
    Application.ScreenUpdating = True

End Sub

VBA如果源文件文件夹为空，如何防止主文件被格式化？

1 个答案: