Excel VBA - Ошибка при выборе листа и проверить несколько листы

Question

Моего кода стоит, как это:

Sub Tele() 

    Dim rowLoop As Long 
    rowLoop = 1 
    strValueToFind = Application.InputBox("Enter a Search value in format xx.xx.xxxx, remember that this will only work if you are on 'Tidal' tab", Title:="DATE FIND", Default:=Format(Date, "Short Date"), Type:=1) 
    ' Loop column A to find value, number corrosponds to letter position in alphabet 
    For rowLoop = 1 To Rows.Count 
     If Sheets("2015").Cells(rowLoop, 1).Value = strValueToFind Then ' If value is in C then do something 
      ' start on cell found from date needed - look at copying range on same Column 
      ' -------------------------------------------------------------------------------------------' 
      Sheets("Vessels").Range("C09").Value = Cells(rowLoop, 1).Offset(0, 1).Resize(1).Value 
      Sheets("Vessels").Range("C10").Value = Cells(rowLoop, 1).Offset(0, 3).Resize(1).Value 
      Sheets("Vessels").Range("C11").Value = Cells(rowLoop, 1).Offset(0, 5).Resize(1).Value 
      Sheets("Vessels").Range("C12").Value = Cells(rowLoop, 1).Offset(0, 7).Resize(1).Value 
      ' Copy cells 1 cell below found value - Montrose? 
      Sheets("Vessels").Range("D09").Value = Cells(rowLoop, 1).Offset(0, 2).Resize(1).Value 
      Sheets("Vessels").Range("D10").Value = Cells(rowLoop, 1).Offset(0, 4).Resize(1).Value 
      Sheets("Vessels").Range("D11").Value = Cells(rowLoop, 1).Offset(0, 6).Resize(1).Value 
      Sheets("Vessels").Range("D12").Value = Cells(rowLoop, 1).Offset(0, 8).Resize(1).Value 
      MsgBox ("Found value on col " & rowLoop) ' 
      Exit Sub 
     End If 
    Next rowLoop ' This is row number, do something with this 

    ' This MsgBox will only show if the loop completes with no success 
    MsgBox ("Date not found, make sure you have input the date correctly and on the right tab") 

End Sub 

Так вот мы делаем Вводятся пользователь дата ищется лист 2015 и копируют некоторые клетки, основанных от этой позиции.

Проблема: Если на другом листе макрос выполняет некоторые странные вещи, используя положение ячейки на этом конкретном листе.
В настоящее время код может проверять только один лист на дату, мне нужно его проверить в общей сложности 5 листов, с 2015 по 2020 год.
Я пробовал разделять запятыми на утверждение if внутри скобок, но я полагаю, что это не так легко.
Любая помощь или пояснение об ошибке было бы замечательно, спасибо заранее!

Answer 1

код должен быть изменен двумя способами: -

1. Установка петли для рабочих листов с 2015-2020
2. Установить прямые ссылки на Cells так, что они работают на правильном листе

У вас все еще есть логическая проблема. В приведенном ниже коде будет выполняться итерация по 5 листам (или независимо от того, что вы добавите в массив), но каждый из них перезапишет те же ячейки на листе «Судно». Я сомневаюсь, что это то, что вы ищете.

Попробуйте это (в концепции): -

Sub Tele() 

    Dim rowLoop As Long 
    rowLoop = 1 
    strValueToFind = Application.InputBox("Enter a Search value in format xx.xx.xxxx, remember that this will only work if you are on 'Tidal' tab", Title:="DATE FIND", Default:=Format(Date, "Short Date"), Type:=1) 

    '*** REFACTOR THIS - change how sheets are selected. You haven't said if other sheets exists 
    'Select the sheets to work through 
    Sheets(Array("2015", "2016", "2017", "2018", "2019", "2020")).Select 

    For Each ws In ActiveWindow.SelectedSheets 

     Debug.Print "Checking " & ws.Name 

     ' Loop column A to find value, number corrosponds to letter position in alphabet 
     For rowLoop = 1 To Rows.Count 
     If ws.Cells(rowLoop, 1).Value = strValueToFind Then ' If value is in C then do something 
      ' start on cell found from date needed - look at copying range on same Column 
      ' -------------------------------------------------------------------------------------------' 


      '*** CHANGE THE LOGIC HERE SO SUBSEQUENT SHEETS DON'T OVERWRITE THE VALUES IN "Vessels" *** 
      Sheets("Vessels").Range("C09").Value = ws.Cells(rowLoop, 1).Offset(0, 1).Resize(1).Value 
      Sheets("Vessels").Range("C10").Value = ws.Cells(rowLoop, 1).Offset(0, 3).Resize(1).Value 
      Sheets("Vessels").Range("C11").Value = ws.Cells(rowLoop, 1).Offset(0, 5).Resize(1).Value 
      Sheets("Vessels").Range("C12").Value = ws.Cells(rowLoop, 1).Offset(0, 7).Resize(1).Value 
      ' Copy cells 1 cell below found value - Montrose? 
      Sheets("Vessels").Range("D09").Value = ws.Cells(rowLoop, 1).Offset(0, 2).Resize(1).Value 
      Sheets("Vessels").Range("D10").Value = ws.Cells(rowLoop, 1).Offset(0, 4).Resize(1).Value 
      Sheets("Vessels").Range("D11").Value = ws.Cells(rowLoop, 1).Offset(0, 6).Resize(1).Value 
      Sheets("Vessels").Range("D12").Value = ws.Cells(rowLoop, 1).Offset(0, 8).Resize(1).Value 
      MsgBox ("Found value on col " & rowLoop) ' 
      Exit Sub 
     End If 
     Next rowLoop ' This is row number, do something with this 

    'Back for next sheet 
    Next ws 

    ' This MsgBox will only show if the loop completes with no success 
    MsgBox ("Date not found, make sure you have input the date correctly and on the right tab") 

End Sub