excel vba日期问题答案

【问题标题】：excel vba date issueexcel vba日期问题
【发布时间】：2012-07-17 13:52:05
【问题描述】：

我只是注意到这一点，我有一个应用程序，用户倾向于填写三个日期的信息。开始日期、结束日期和截止日期。下面列出了其中一个日期框的示例

Private Sub txtEDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

     'Dim dDate As Date
    dDate = DateSerial(Year(Date), Month(Date), Day(Date))
    txtEDate.Value = Format(txtEDate.Value, "dd/mm/yyyy")
    dDate = txtEDate.Value = ""
End Sub

我现在注意到的问题是，当我提交这些日期时，当我选择 2012 年 1 月 3 日或 2012 年 5 月 6 日时，它们在我的工作表上分别更改为 3/1/2012 和 6/5。如果我的日期输入是 2012 年 6 月 13 日，它将保持不在 12 个月范围内。 excel表格与我设置的表格格式相同。也许这是我提交日期的问题。

Private Sub cmdOK_Click()
Dim checks As Integer

trim.trimALL
Call Check_Correct_Data_Entry_Total(checks)

If checks = 1 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Name..."
    Me.txtName.SetFocus
End If

If checks = 2 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Number..."
    Me.txtPhone.SetFocus
End If
If checks = 3 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a ID..."
    Me.txtID.SetFocus
End If
If checks = 4 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Department.."
    Me.txtDepartment.SetFocus
End If
If checks = 5 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a End Date.. "
    Me.txtEDate.SetFocus
End If
If checks = 6 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Analysis Dead Date.. "
    Me.txtDeadDate.SetFocus
End If
If checks = 7 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Analysis..."
    Me.cboAnalysis.SetFocus
End If
If checks = 8 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Application..."
    Me.cboApplication.SetFocus
End If
If checks = 9 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter amount of Disk Space you will be using..."
    Me.txtDisks.SetFocus
End If

If checks = 10 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Cluster..."
    Me.cboCluster.SetFocus
End If
If checks = 11 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Core Amount..."
    Me.cboCores.SetFocus
End If

If checks = 0 Then

    ActiveWorkbook.Sheets("Course Bookings").Activate

    Dim Row_to_Record_Data As Long

    Row_to_Record_Data = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

    'Generate Unique Key for each new entry (Key = string of userid + numeric timestamp + random 3 letter string)

    Dim DateNumber As Long
    Dim RandomString1 As String
    Dim RandomString2 As String
    Dim RandomString3 As String
    Dim RandomString As String

    Dim Unique_Key As String

    DateNumber = Date
    RandomString1 = Chr(Application.WorksheetFunction.RandBetween(65, 90))
    RandomString2 = Chr(Application.WorksheetFunction.RandBetween(65, 90))
    RandomString3 = Chr(Application.WorksheetFunction.RandBetween(65, 90))
    RandomString = RandomString1 & RandomString2 & RandomString3
    Unique_Key = Format(Hour(Now), "00") & Format(Minute(Now), "00") & Format(Second(Now), "00") & RandomString

    'Check if overwriting entry selected from frmList ListBox
    If Overwrite_Row <> 0 Then Row_to_Record_Data = Overwrite_Row

    Cells(Row_to_Record_Data, 1).Value = txtName.Value
    Cells(Row_to_Record_Data, 2) = txtPhone.Value
    Cells(Row_to_Record_Data, 3) = LCase(txtID.Value)
    Cells(Row_to_Record_Data, 4) = txtDepartment.Value

    Cells(Row_to_Record_Data, 5) = cboAnalysis.Value
    Cells(Row_to_Record_Data, 6) = cboApplication.Value

   'ActiveCell.Offset(0, 7) = cboPriority.Value saved for priority to fill in off administration form

    Cells(Row_to_Record_Data, 9) = txtSDate.Value
    Cells(Row_to_Record_Data, 10) = txtDeadDate.Value
    'ADD ESTIMATED DATE HERE!!!!.
    Cells(Row_to_Record_Data, 11) = txtEDate.Value
    Cells(Row_to_Record_Data, 12) = cboCluster.Value
    Cells(Row_to_Record_Data, 13) = cboCores.Value
    Cells(Row_to_Record_Data, 14) = txtDisks.Value
    Cells(Row_to_Record_Data, 16) = txt_sge_number.Value


    'DVM CHOICES option.
    If optDefinition = True Then
        Cells(Row_to_Record_Data, 7).Value = "Definition"
    ElseIf optValidation = True Then
        Cells(Row_to_Record_Data, 7).Value = "Validation"
    Else
        Cells(Row_to_Record_Data, 7).Value = "Methods"
    End If

    'Enter Unique Key if new entry
    If Overwrite_Row = 0 Then Cells(Row_to_Record_Data, 15).Value = Unique_Key

End If

'frmCourseBooking.Error_Messages.Caption =

    Range("A1").Select

'clear form to avoid mishaps
If Overwrite_Row = 0 Then
    Accecptance_label.Caption = "Adding New Request, Recommend Clear Form After."
Else
    Accecptance_label.Caption = "Editted Request, Recommend Clear Form After."
End If

If checks = 0 Then
    Error_Messages.Caption = ""
End If

'Reset Overwrite_Row to zero
Overwrite_Row = 0


End Sub

这是我将这些日期提交到我的表单的全部功能。特别是 Cells(Row_to_Record_Data, 1).Value = txtName.Value。我的问题是如何让它坚持我在表单中设置的格式，并且一旦提交就不会改变？

提前致谢

【问题讨论】：

您是否使用字符串设置工作表？也就是说，您使用的是Cell.Value = dDate 还是Cell.Value = txtEDate.Value？使用Cell.Value = dDate 应该可以避免这个问题。格式“dd/mm/yyyy”是特殊的。如果将单元格的格式设置为“dd/mm/yyyy”，然后显示该单元格的 NumberFormat，您将得到“mm/dd/yyyy”。标有星号的日期格式显示了此属性。我总是使用明确的格式，例如“dd mmm yyyy”。有关更多信息，请参阅我的问题 stackoverflow.com/q/9839676/973283。
在第一个代码部分之后的每个单元格中命名输入。但是如果我输入 cell.value=dDate 它会给我今天的日期，因为 dDate 设置为日期。我将如何调整 txtEdate 部分的第一个代码块以保持我想要的英国格式？我读了你的帖子，现在只是想掌握它
对了，我把它改成“dd mmm yyyy”格式，然后告诉我的工作表在短时间内显示，现在似乎可以正常显示了，谢谢你的回复

标签： excel vba

【解决方案1】：

Private Sub txtEDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)       
'Dim dDate As Date    
 dDate = DateSerial(Year(Date), Month(Date), Day(Date))     
txtEDate.Value = Format(txtEDate.Value, "dd mmm yyyy")     
dDate = txtEDate.Value = "" 
End Sub

根据@Tony Dallimore 的输入修改答案

【讨论】：