输入框避免空白条目

Question

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

 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 如果按下取消 return 类型是 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

输入框避免空白条目

Input Box avoid blank entries

excel

vba

loops

copy