Excel日期选择器日期格式

时间:2018-06-09 18:15:25

标签: excel excel-vba datepicker vba

我遇到的问题是excel中的日期选择器似乎使用我正在搜索的日期的美国版本。

我正在尝试检查工作表是否存在于一系列单元格中,哪个日期存在于DTpicker1和DTpicker2的参数中。

有人可以建议我如何强制代码以英国格式检查日期吗?

Private Sub CommandButton1_Click()
Dim s As Worksheet, wb As Workbook
UserForm1.Hide
For Each s In Worksheets
    If CBool(Application.CountIfs(s.Range("E11:E37"), ">" & 
    Format(DTPicker1.Value, "dd/mm/yy"), _ s.Range("E11:E37"), "<" & 
Format(DTPicker2.Value, "dd/mm/yy"))) Then
        If wb Is Nothing Then
            s.Copy
            Set wb = ActiveWorkbook
        Else
            s.Copy after:=wb.Worksheets(wb.Worksheets.Count)
        End If
    End If
Next s

If wb Is Nothing Then
    MsgBox ("No Records Found")
Else
    wb.SaveAs Filename:="Technicians - Batch Record Report" & Format(Date, 
"ddmmyyyy"), _
          FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If
End Sub

归功于@Jeeped谁让我这么远!

更新:代码通过撤消日期格式来运作:

Private Sub CommandButton1_Click()
Dim s As Worksheet, wb As Workbook
UserForm1.Hide
For Each s In Worksheets
    If CBool(Application.CountIfs(s.Range("E11:E37"), ">" & 
    Format(DTPicker1.Value, "mm/dd/yy"), _ s.Range("E11:E37"), "<" & 
Format(DTPicker2.Value, "mm/dd/yy"))) Then
        If wb Is Nothing Then
            s.Copy
            Set wb = ActiveWorkbook
        Else
            s.Copy after:=wb.Worksheets(wb.Worksheets.Count)
        End If
    End If
Next s

If wb Is Nothing Then
    MsgBox ("No Records Found")
Else
    wb.SaveAs Filename:="Technicians - Batch Record Report" & Format(Date, 
"ddmmyyyy"), _
          FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If
End Sub

2 个答案:

答案 0 :(得分:0)

您可以手动强制检查

If dateValue.NumberFormat <> "mm/dd/yyyy" Then     '<-- provide the date format to validate with

答案 1 :(得分:0)

撤消日期格式,一切正常......

Private Sub CommandButton1_Click()
Dim s As Worksheet, wb As Workbook
UserForm1.Hide
For Each s In Worksheets
If CBool(Application.CountIfs(s.Range("E11:E37"), ">" & 
Format(DTPicker1.Value, "mm/dd/yy"), _ s.Range("E11:E37"), "<" & 
Format(DTPicker2.Value, "mm/dd/yy"))) Then
    If wb Is Nothing Then
        s.Copy
        Set wb = ActiveWorkbook
    Else
        s.Copy after:=wb.Worksheets(wb.Worksheets.Count)
    End If
End If
Next s

If wb Is Nothing Then
MsgBox ("No Records Found")
Else
wb.SaveAs Filename:="Technicians - Batch Record Report" & Format(Date, 
"ddmmyyyy"), _
      FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If
End Sub