[英]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.