使用vba复制日期而不会丢失格式

时间:2019-12-16 09:53:30

标签: excel vba formatting

我已经建立了一个用于培训记录的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

https://i.stack.imgur.com/plmvl.png

enter image description here

0 个答案:

没有答案
相关问题