输入框避免空白条目

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