Ошибка времени выполнения 13, когда столбец не имеет других значений

Question

Следующее является частью моей программы, которая выполняет следующую функцию

Он будет смотреть на столбец K и столбец L и создавать вкладки в соответствии с комбинациями. Например, если столбец K имеет значение ячейки "Apple", а столбец L имеет значение одной ячейки "Orange", будет создана вкладка 1) Apple - Orange

В новой вкладке будут все строки с этой комбинацией. Поэтому после завершения макроса все данные будут разделены на различные вкладки в соответствии с комбинацией K - L.

Моя проблема заключается в том, что он дает ошибку времени выполнения, когда весь столбец K или весь столбец L имеют только одно значение. Например, если весь столбец K имеет 10 строк, а все ячейки столбца k имеют значение Apple, это приведет к ошибке. То же самое касается столбца L.

Dim m As Integer
Dim area As Range
Count = Range("K:K").SpecialCells(xlLastCell).Row
ActiveSheet.Range("K2:K" & Count).AdvancedFilter Action:=xlFilterCopy,   
CopyToRange:=ActiveSheet.Range("Z2"), Unique:=True

Columns(26).RemoveDuplicates Columns:=Array(1)


Count1 = Range("L:L").SpecialCells(xlLastCell).Row
ActiveSheet.Range("L2:L" & Count1).AdvancedFilter Action:=xlFilterCopy,    
CopyToRange:=ActiveSheet.Range("Y2"), Unique:=True
Columns(25).RemoveDuplicates Columns:=Array(1)
Dim arrayv As String

Dim Text1 As String

Dim arrayv1 As String

last = Range("Z2").End(xlDown).Row

arrayv = WorksheetFunction.Transpose(Sheets(1).Range("Z2:Z" & last).Value)


last1 = Range("Y2").End(xlDown).Row

arrayv1 = WorksheetFunction.Transpose(Sheets(1).Range("Y2:Y" & last1).Value)

Columns(26).EntireColumn.Delete
Columns(25).EntireColumn.Delete

Dim i As Long, j As Long
Dim flag As Variant
flag = 1

A = 1
s = 2
For c = 1 To UBound(arrayv1)

For t = 1 To UBound(arrayv)

Sheets.Add().Name = "Sheet" & s
ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)

With Worksheets("Sheet1")
j = 2
.Rows(1).Copy Destination:=Worksheets("Sheet" & s).Range("A" & 1)
flag = 1
For i = 2 To Count
     If .Cells(i, 11).Value = arrayv(t) Then
     If .Cells(i, 12).Value = arrayv1(c) Then
     Text = .Cells(i, 15).Value


     flag = 0

           .Rows(i).Copy Destination:=Worksheets("Sheet" & s).Range("A" & j)


           j = j + 1
           End If

     End If
  Next i

    If flag = 1 Then

    Sheets("Sheet" & s).Delete

    Else

   Text1 = Left(Text, 4)

Строка ошибки, когда столбец K имеет только одно значение

 arrayv = WorksheetFunction.Transpose(Sheets(1).Range("Z2:Z" & last).Value)

Строка ошибки, когда столбец L имеет только одно значение

arrayv1 = WorksheetFunction.Transpose(Sheets(1).Range("Y2:Y" & last1).Value)

Answer 1

Если имеется только одно значение Y2 или Z2 вниз, тогда используется свойство Range,End с xlDirection, равным xlDown собирается ссылаться на строку 1 048 576. Метод WorksheetFunction.Transpose имеет ограничение в 65 536. Все, что превышает этот предел, приведет к

Ошибка выполнения "13":
Несоответствие типов.

Измените направление поиска последней строки, чтобы посмотреть снизу вверх с помощью xlUp,

last = Range("Z" & rows.count).End(xlUp).Row
arrayv = WorksheetFunction.Transpose(Sheets(1).Range("Z2:Z" & last).Value)


last1 = Range("Y" & rows.count).End(xlUp).Row
arrayv1 = WorksheetFunction.Transpose(Sheets(1).Range("Y2:Y" & last1).Value)