Excel vba无法在用户输入时找到日期

时间:2015-07-18 00:48:41

标签: excel vba date find inputbox

我仍然对VBA有点新鲜,我的代码今天早些时候工作但现在由于某种原因,即使它存在,它也停止在我选择的列中找到日期。 我正在阅读每一行并寻找两个标准(1.迁移日期,2。网络)。完成后,我会根据他们的标准复制行以分离工作表,并在以后保存它们。我现在的问题是,尽管我输入的日期,它还没有找到它 - 我确实以DD / MM / YYYY格式输入它作为我的基础格式。尽管我把它放到了Err_Execute。

以下是我正在使用的数据类型:

  • ColA PCname(即John的机器)
  • ColB用户名(即John Doe)
  • ColC DeviceType(即笔记本电脑)
  • ColD Network(即Jody的网络)
  • ColE Migration wave(即第1波)
  • ColF设备的最佳用户
  • ColG最后登录的人
  • 设备的ColH位置
  • ColI迁移日期(在另一个工作簿中查找,所以仍然是公式)ColJ用户的电子邮件
  • ColK SR#
  • ColL迁移日期(复制为值而非公式)
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."`

任何帮助,找出它为什么不再找到日期将非常感激。

错误handeler虽然没有工作,所以尽管我输入了值(LSearchValue),我仍然得到所有数据都被复制的msg。 除了修复拼写错误之外,我改变了我的代码,希望让错误的handeler工作。有人能帮忙吗?是否有更好的方法来处理在我的' 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

0 个答案:

没有答案