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

0 ответов

Другие вопросы по тегам