Question

vba 根据用户输入的日期将数据从“源”复制到“最终”选项卡，源在复制到“导出”选项卡之前已重新格式化（删除和添加列等） “最终”选项卡。下面的 vba 可以工作，但是，我想收紧流程并避免用户简单地单击“确定”或“取消”，因为这会导致所有来自源电子表格的数据被复制

 Public Sub Copydata()

  Dim CopySheet As Worksheet
  Dim PasteSheet As Worksheet
  Dim FinalSheet As Worksheet
  Dim nextRow As Long
  Dim FinalRow As Long
  Dim lastRow As Long
  Dim thisRow As Long
  Dim myValue As Date
  Set ws = ThisWorkbook.Sheets.Add(After:= _
         ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
         
  ws.Name = "Export"
  ' Get the sheet references
  Set CopySheet = Sheets("Source")
  Set PasteSheet = Sheets("Export")
  Set FinalSheet = Sheets("Final")


  lastRow = CopySheet.Cells(CopySheet.Rows.Count, "B").End(xlUp).Row
  nextRow = PasteSheet.Cells(PasteSheet.Rows.Count, "A").End(xlUp).Row + 1

  myValue = InputBox("Enter start date to transfer", "Input Date")

 For thisRow = 1 To lastRow
     
 If CopySheet.Cells(thisRow, "B").Value >= myValue Then
 
    CopySheet.Cells(thisRow, "B").EntireRow.Copy Destination:=PasteSheet.Cells(nextRow, "A")
    
    
  nextRow = nextRow + 1
  End If
  Next thisRow""

我曾想过一个循环，直到输入日期，例如：

    Do
    myValue = InputBox("Enter start date to transfer", "Input Date")

    If myValue = "" Then
    MsgBox "You must enter a date as dd/mm/yyyy", vbOKOnly, "Invalid Date"
    Else
    Exit Do
    End If
    Loop

但即使输入了日期，它也会循环，并且不会继续执行代码或类型不匹配的错误。

任何指导将不胜感激，谢谢

Answer 1

如果按下取消，则使用 If VarType(RetVal) = vbBoolean And RetVal = False Then 检查用户是否按下取消，返回类型为 False 布尔值。这样，如果用户想停止继续，他可以按取消。

此外，我建议按照我在下面所做的那样根据 dd/mm/yyyy 验证输入日期。

Option Explicit

Public Sub Example()
    Do
        Dim RetVal As Variant
        RetVal = Application.InputBox("Enter start date to transfer", "Input Date", Type:=2)
        
        If VarType(RetVal) = vbBoolean And RetVal = False Then
            ' user pressed cancel
            Exit Sub
        End If
        
        If RetVal = vbNullString Or Not IsValidDate(RetVal) Then
            MsgBox "You must enter a date as dd/mm/yyyy", vbOKOnly + vbExclamation, "Invalid Date"
        Else
            Exit Do
        End If
    Loop
    
    ' input date as numeric date instead of string
    Dim NumericDateFromInput As Date
    NumericDateFromInput = GetNumericDateFromStringDDMMYYYY(InputVal)
End Sub


' returns true if the input string is a valid date of the format dd/mm/yyyy
Public Function IsValidDate(ByVal InputVal As String) As Boolean
    IsValidDate = Not (InputVal = 0)
End Function


' returns a numeric date if the input string is of the format dd/mm/yyyy
Public Function GetNumericDateFromStringDDMMYYYY(ByVal InputVal As String) As Date
    Dim Parts() As String
    Parts = Split(InputVal, "/")
    
    If UBound(Parts) <> 2 Then Exit Function
    
    Dim NumericDate As Date
    On Error Resume Next
    NumericDate = DateSerial(Parts(2), Parts(1), Parts(0))
    On Error GoTo 0
    
    If InputVal = Format$(GetNumericDateFromStringDDMMYYYY(InputVal), "dd\/mm\/yyyy") Then
        GetNumericDateFromStringDDMMYYYY = NumericDate
    End If
End Function

请注意，根据格式化的 Format$ 日期重新检查数字日期是为了确保输入的格式为 14/07/2021 而不是 14/7/2021，但输入的日期存在！因为如果你不这样做，那么输入一个像 32/07/2021 这样的无效日期会被 DateSerial() 调整到 01/08/2021 中，然后你就会得到一个错误的日期，这不是用户输入的日期以及什么用户输入的日期无效。

Answer 2

也许这对你有用？一个问题是您将 myValue 声明为 Date，因此如果未输入日期，您将得到不匹配的结果。

Sub x()

Dim myValue As Variant

Do
    myValue = Application.InputBox("Enter start date to transfer", "Input Date")
    If myValue = False Then Exit Sub 'cancel
    If IsDate(myValue) Then
        Exit Do
    Else
        MsgBox "You must enter a date as dd/mm/yyyy", vbOKOnly, "Invalid Date"
    End If
Loop

End Sub

输入框避免空白条目

2 个答案: