Excel vba не может найти дату при вводе пользователем
Я все еще немного новичок в VBA, и мой код работал ранее сегодня, но теперь по какой-то причине он перестал находить дату в выбранном мной столбце, даже если он присутствует. Я читаю каждую строку и ищу два критерия (1. дата миграции, 2. сеть). После этого я копирую строки, в зависимости от их критериев, в отдельные листы и, следовательно, сохраняю их позже. Моя проблема сейчас в том, что, несмотря на введенную мной дату, она больше не находит ее - и я обязательно ввожу ее в формате ДД / ММ / ГГГГ, поскольку это мой основной формат. Несмотря на то, что я положил, это загружает меня до Err_Execute.
Вот данные, с которыми я работаю:
- ColA PCname (то есть машина Джона)
- Имя пользователя ColB (т.е. John Doe)
- ColC DeviceType (т.е. ноутбук)
- Сеть ColD (то есть сеть Джоди)
- Волна миграции ColE (т.е. 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."`
Любая помощь в выяснении, почему он больше не находит дату, будет очень признательна.
Однако обработчик ошибок не работает, поэтому, несмотря на значение, введенное для ввода (LSearchValue), я все равно получаю сообщение о том, что все данные были скопированы. Помимо исправления опечатки, я немного изменил свой код в надежде заставить обработчик ошибок работать. Кто-нибудь может помочь? Возможно, есть лучший способ справиться со значением, которого нет в моем столбце "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