subscript out of range

[Казанский]

Katiy2002, приложите файл-пример, объясните задачу словами. Может, можно все сделать проще, формулами/фильтрами например.

[Hugo121]

Сообщение от Katiy2002

мне нужен так)

- почему?

[Katiy2002]

Файл не удается загрузить, слишком большой даже архив.
Есть выгрузка анкет на одном листе книги. Каждый день с утра макросом из этой выгрузки подтягивается на другой лист анкеты с определенным статусом и с датами от сегодняшнего числа, но в течении дня эта выгрузка обновляется не один раз. То есть при повторном переносе на второй лист анкет на втором листе появляются не только новые анкеты, но и дублируются старые за сегодняшнее число, нужно это исправить.
Я загнала в массив номера анкет со второго листа, и при его обновлении сравниваю номер анкеты с первого листа со значениями этого массива. Если номера анкет совпадают, значит загружать ее не нужно на второй лист, тк она там уже есть.
Еще раз приложу код

Public Sub Main()

llastr = Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(Rows.Count, 2).End(xlUp).Row 'çàïîìíèëè ïîñëåäíþþ ñòðîêó
ReDim MnumberA(1 To llastr)
s = 0 ' ñòðîêè ìàññèâà
For y = 3 To Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(Rows.Count, 2).End(xlUp).Row 'ïåðåáèðàþ ñòðîêè íà ëèñòå
 If Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(y, 2) <> " " Then ' óñëîâèå îòáîðà
     s = s + 1 ' íîìåð ñòðîêè ìàññèâà
     MnumberA(s) = CStr(Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(y, 2).Value) ' çàïèñü â ïåðâóþ êîëîíêó
  End If
Next y
MC = True
MANK = RangeCNT("ANK", 1, 1)
For i = 2 To MANK
     If Sheets("ANK").Cells(i, 11).Value = 2 And Sheets("ANK").Cells(i, 13).Value > CDate(Now()) Then  'ïðîâåðêà äàòû
        If FindPos(CStr(Sheets("ANK").Cells(i, 1).Value), "ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ", 3, 2) = 0 Then
          AddANK i, RangeCNT("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ", 3, 1)
        End If
     End If
Next i
MC = False
MsgBox ("Âûïîëíåíî!")
End Sub

Public Function poisk(MnumberA(), k) As Boolean
MANK = RangeCNT("ANK", 1, 1)
For i = 2 To MANK
x = CStr(Sheets("ANK").Cells(i, 1).Value)
 For k = 3 To UBound(MnumberA)
    'On Error Resume Next
    If x <> CStr(MnumberA(k)) Then poisk = True: Exit Function
 Next k
Next i
End Function

Function FindPos(FVal As String, SName As String, FRow As Long, FCol As Long)
For i = 0 To RangeCNT(SName, FRow, FCol)
 If CStr(Sheets(SName).Cells(i + FRow, FCol).Value) = FVal Then
  FindPos = i
  Exit Function
 End If
   FindPos = 0
Next i
End Function

Function RangeCNT(SName As String, FRow As Long, FCol As Long)
 i = 0
 While Sheets(SName).Cells(i + FRow, FCol) <> ""
   i = i + 1
 Wend
 RangeCNT = i + FRow
End Function

Function MaxID(SName As String, FRow, FCol)
 i = 0
 j = 0
 While Sheets(SName).Cells(j + FRow, FCol) <> ""
  If Sheets(SName).Cells(j + FRow, FCol).Value > i Then
   i = Sheets(SName).Cells(j + FRow, FCol).Value
  End If
  j = j + 1
 Wend
 MaxID = i
End Function

Sub AddANK(XRow, TargetX)
MANK = RangeCNT("ANK", 1, 1)
For o = 2 To MANK
 If poisk(MnumberA(), o) = True Then 'ïðîâåðêà íàëè÷èÿ çàïèñè â ðååñòðå
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 1) = MaxID("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ", 3, 1) + 1
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 2) = Sheets("ANK").Cells(XRow, 1)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 3) = Sheets("ANK").Cells(XRow, 2)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 5) = Sheets("Ëèñò1").Range("A2")
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 4) = Sheets("ANK").Cells(XRow, 12)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 6) = "Öåíòð äîñòàâêè" 'ÊÊ Ñ ËÏ 120 Ä
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 8) = Now()
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 9) = Now()
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 10) = "ÊÊ Ñ ËÏ 120 Ä"
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 11) = Sheets("ANK").Cells(XRow, 3)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 12) = Sheets("ANK").Cells(XRow, 4)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 13) = Sheets("ANK").Cells(XRow, 5)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 15) = Sheets("ANK").Cells(XRow, 8)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 16) = Sheets("ANK").Cells(XRow, 7)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 17) = Sheets("ANK").Cells(XRow, 17)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 21) = Sheets("ANK").Cells(XRow, 16) + ", " + Sheets("ANK").Cells(XRow, 17) + ", " + Sheets("ANK").Cells(XRow, 18) + ", " + Sheets("ANK").Cells(XRow, 19) + ", " + Sheets("ANK").Cells(XRow, 20) + ", " + Sheets("ANK").Cells(XRow, 21)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 22) = Sheets("ANK").Cells(XRow, 13)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 23) = Sheets("ANK").Cells(XRow, 14)
  Sheets("ÐÅÅÑÒÐ ÄÎÑÒÀÂÊÈ").Cells(TargetX, 24) = Sheets("ANK").Cells(XRow, 22)
 End If
Next o
End Sub

[Казанский]

Katiy2002, зачем опять эта простыня нечитаемого кода? Файл-пример может содержать в 100 раз меньше данных, чем рабочий, лишь бы была понятна структура данных и что с ними надо сделать.

[Katiy2002]

Вот файл

[Hugo121]

Честно пытался помочь - не вышло: кода в файле нет, не понял что и как нужно делать, не нашёл ни одного совпадения между листами... Я пас.
P.S. Кстати про объём - если из файла удалить все эти лишние миллионы пустых строк - там остаётся всего 180 кб, которые можно ещё чуть незначительно поджать архиватором.

[Казанский]

Есть одно совпадение - В33 с первого листа находится в А23 второго листа.
Можно получить массив значений совпадает/не_совпадает с помощью функций листа ЕНД(ПОИСКПОЗ()):

Sub bb()
Dim v()
  With Worksheets("РЕЕСТР ДОСТАВКИ")
    v = Application.IsNA(Application.Match(.Range("B3", .Cells(.Rows.Count, "B").End(xlUp)), Range("ANK!A:A"), 0))
  End With
Dim x: For Each x In v: Debug.Print x: Next 'вывод массива в Immediate
End Sub

В данном случае выводится массив

True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
False

т.е. все номера анкет из первого листа, кроме последнего, не находятся на втором листе и подлежат переносу.
В файле книга с удаленными пустыми строками.