Excel vba无法find用户input的date

我对VBA还是有点新鲜感,而且我的代码今天早些时候工作,但现在由于某种原因,即使它存在,它也停止在我select的列中finddate。 我正在阅读每一行,并寻找两个标准(1.移植date,2.networking)。 一旦完成,我根据他们的标准复制行来分离工作表,并随后保存它们。 我现在的问题是,尽pipe我input的date,它不会再find它 – 我确实以DD / MM / YYYY格式input,因为这是我的基础格式。 尽pipe我把它放在了Err_Execute。

这是我正在使用的数据types:

  • ColA PCname(即John的机器)
  • ColB用户名(即John Doe)
  • ColC DeviceType(即笔记本电脑)
  • ColDnetworking(即Jody的networking)
  • ColE迁移波(即第一波)
  • ColF设备的顶级用户
  • ColG最后一个人login
  • 设备的位置
  • ColI迁移date(在另一个工作簿中查找,所以仍然是一个公式)ColJ用户的电子邮件
  • ColK SR#
  • ColL迁移date(作为值而不是公式复制)

Sub test() Dim LSearchRow As Integer Dim LCopyToRow1 As Integer Dim LCopyToRow2 As Integer Dim LSearchValue As String On Error GoTo Err_Execute Sheets("Confirmed devices").Activate Range("I2:I10000").Select Selection.Copy Range("L2:L10000").PasteSpecial xlPasteValues Sheets.Add.Name = "Jody" Sheets.Add.Name = "Jason" LSearchValue = InputBox("Which migration date do you wish to prepare the files for?", "The format has to be DD/MM/YYYY.") LSearchRow = 2 LCopyToRow1 = 1 LCopyToRow2 = 1 While Len(Range("A" & CStr(LSearhRow)).Value) > 0 If Range("L" & CStr(LSearchRow)).Value = LSearchValue And Range("D" & CStr (LSearchRow)).Value = "Jody's network" Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("Jody").Select Rows(CStr(LCopyToRow1) & ":" & CStr(LCopyToRow1)).Select Sheets("Jody").Paste LCopyToRow1 = LCopyToRow1 + 1 Sheets("Confirmed devices").Select End If If Range("L" & CStr(LSearchRow)).Value = LSearchValue And Range("D" & CStr(LSearchRow)).Value = "Jason" Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("Jason").Select Rows(CStr(LCopyToRow2) & ":" & CStr(LCopyToRow2)).Select Sheets("Jason").Paste LCopyToRow2 = LCopyToRow2 + 1 Sheets("Confirmed devices").Select End If LSearchRow = LSearchRow + 1 Wend 'MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "That date was not found."` 

任何帮助找出为什么它不会finddate将非常感激。


虽然我为input(LSearchValue)的价值,我仍然得到所有数据已被复制的味精。 除了修正这个错字之外,我改了一下我的代码,希望能让error handling程序正常工作。 有人能帮忙吗? 有没有更好的办法来处理我的'L'栏中找不到的价值?

 Sub test() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim LSearchRow As Integer Dim LCopyToRow1 As Integer Dim LCopyToRow2 As Integer Dim LSearchValue As String Dim fname1 As String Dim fname2 As String Dim fpath As String Dim Newbook1 As Workbook Dim Newbook2 As Workbook Sheets("Confirmed devices").Activate Range("I2:I10000").Select Selection.Copy Range("L2:L10000").PasteSpecial xlPasteValues On Error GoTo Err_Execute LSearchValue = InputBox("Which migration date do you wish to prepare the files for?", "The format has to be DD/MM/YYYY.") LSearchRow = 2 LCopyToRow1 = 1 LCopyToRow2 = 1 Sheets.Add.Name = "Jodi" Sheets.Add.Name = "Jason" While Len(Range("A" & CStr(LSearchRow)).Value) > 0 If Range("L" & CStr(LSearchRow)).Value = LSearchValue And Range("D" & CStr(LSearchRow)).Value = "Jodi's Network” Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("Jodi").Select Rows(CStr(LCopyToRow1) & ":" & CStr(LCopyToRow1)).Select Sheets("Jodi").Paste LCopyToRow1 = LCopyToRow1 + 1 Sheets("Confirmed devices").Select ElseIf Range("L" & CStr(LSearchRow)).Value = LSearchValue And Range("D" & CStr(LSearchRow)).Value = "Jason's Network" Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("Jason").Select Rows(CStr(LCopyToRow2) & ":" & CStr(LCopyToRow2)).Select Sheets("Jason").Paste LCopyToRow2 = LCopyToRow2 + 1 Sheets("Confirmed devices").Select End If LSearchRow = LSearchRow + 1 Wend MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "There are no migrations for this date" End Sub