简体   繁体   English

VBA - 如果最大日期在当前月份,如何识别列中的最大日期并使用当前年份和月份保存文件

[英]VBA - How to identify max date in a column and save file with current year and month if the max date is in the current month

This is a two part problem that I'm trying to solve.这是我试图解决的两部分问题。 First, I'd like to identify the max date in a column.首先,我想确定列中的最大日期。 If the max date is in the current month, then I'd like to save the file in the current format using the current year and month (filename YYYYMM).如果最大日期在当前月份,那么我想使用当前年份和月份(文件名 YYYYMM)以当前格式保存文件。 If the date is less than the current month, I'd like to save the file with current year and prior month.如果日期小于当前月份,我想保存当前年份和上个月的文件。

This is the code I've started off with to identify the max date but my MsgBox display the time instead of date so I can't confirm if it's actually working.这是我开始用于识别最大日期的代码,但我的 MsgBox 显示时间而不是日期,所以我无法确认它是否真的有效。

Dim Max_date As Date
xl.Sheets("Data").Visible = True
xl.Sheets("Data").Select
xl.Range("I:I").Select
Max_date = Application.WorksheetFunction.Max(xl.Range("I:I"))
MsgBox Max_date

please take the time to check the code and configure all you need.请花时间检查代码并配置您需要的所有内容。 Good luck祝你好运

'This es the configurable part
Sub Export()
    Dim filePath As String, fileName As String
    filePath = OpenFileExplorer(msoFileDialogFolderPicker) '"" 'define your save path         or use -->'OpenFileExplorer(msoFileDialogFolderPicker)
    fileName = "eg. 09_03_2021" 'here you code max, remember dont use slash
    Copy_Save_Worksheet_As_Workbook "your Sheet to save", fileName, filePath
End Sub

'Starting a procedure to save a worksheet as new workbook
Public Sub Copy_Save_Worksheet_As_Workbook(SheetNameToCopy_ As String, saveAs__ As     String, path_ As String)
    Application.ScreenUpdating = False
    Dim wkb As Workbook
    'Check this line too
    Const fileExtencion = ".xlsx"
    'this is to check if already book open with same name
    For Each wkb In Workbooks
        If wkb.Name = saveAs__ & fileExtencion Then
            Workbooks(wkb.Name).Close False
        End If
    Next
   
    Dim finalPath As String
    finalPath = path_ & "\" & saveAs__
    ThisWorkbook.Sheets(SheetNameToCopy_).Select
    ActiveSheet.Copy
    ActiveSheet.SaveAs fileName:=finalPath & ".xlsx"
    Application.ScreenUpdating = True
 End Sub

Public Function OpenFileExplorer(t_ As MsoFileDialogType) As String
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(t_)
   With fd
      .AllowMultiSelect = False

      ' Set the title of the dialog box.
      .Title = "Where to save"

      ' Clear out the current filters, and add our own.
      .Filters.Clear
     If t_ = msoFileDialogFilePicker Then
          .Filters.Add "All Files", "*.*"
     End If
     If .Show = True Then
         OpenFileExplorer = .SelectedItems(1)
     Else
        OpenFileExplorer = ""
     End If
   End With
End Function

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM