我已经建立了一个用于培训记录的excel数据库。我创建了一个输入表,以自动将日期添加到训练矩阵中,而无需人工查找。但是,当复制新日期时,日期和月份会切换,就好像是从美国格式转换为英语格式,反之亦然。
例如,“添加记录”表中的日期为“ 02/01/2019”,而“培训矩阵”表中的日期为“ 01/02/2019”。
两者均在excel中格式化为英国日期。是否有VBA代码来确保不会发生这种情况?
Option Explicit
Sub AddRecord()
Dim UpdateName As String, UpdateMod As String, UpdateDate As String
Dim FoundCell_1 As Range, FoundCell_2 As Range
Dim FoundCell_Row As Long, FoundCell_Col As Long, NewDate As Range
Dim i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Training Mattrix").Rows.EntireRow.Hidden = False
UpdateName = Sheets("Add Record").Range("EmployeeName").Value
UpdateMod = Sheets("Add Record").Range("TrMod").Value
UpdateDate = Sheets("Add Record").Range("TrDate").Value
'VBLookup
For i = 6 To 20
Set FoundCell_1 = Sheets("Training Mattrix").Range("A:A").Find(what:=UpdateName, LookIn:=xlValues)
If FoundCell_1 Is Nothing Then
MsgBox "Name was not found, please try again", vbCritical
Exit Sub
Else: FoundCell_Row = FoundCell_1.Row
Set FoundCell_2 = Sheets("Training Mattrix").Range("2:2").Find(what:=UpdateMod, LookIn:=xlValues)
If FoundCell_2 Is Nothing Then
MsgBox "Training module was not found, please try again", vbCritical
Exit Sub
Else: FoundCell_Col = FoundCell_2.Column
Set NewDate = Sheets("Training Mattrix").Cells(FoundCell_Row, FoundCell_Col)
NewDate.Value = UpdateDate
End If
End If
Next i
MsgBox "Training records update! Thank you"
Sheets("Training Mattrix").Range("TrainingRef").EntireRow.Hidden = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub