Увеличить охват (массив) макроса.

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Увеличить охват (массив) макроса. (Макросы/Sub)

zegor

Дата: Пятница, 10.08.2018, 16:47 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 132

Репутация: 1 ±

Замечаний: 0% ±

Excel 2007

Привет, excelworld. Есть макрос, он "блочно" перебрасывает данные с одного листа на другой по критериям (есть список). Собственно у меня получается охватывать только 67 критериев. При попытке добавить критерий заканчивается строка и последнее добавление окрашивается в красный цвет. Если это игнорировать макрос отказывается работать. Помоги пожалуйста преодолеть лимит в 67 критериев.
[vba]

Код

Sub perenos_1_67()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim MyArr
Dim Found_b As Range
Dim iAdr As String
MyArr = Array(Cells(2, 60), Cells(3, 60), Cells(4, 60), Cells(5, 60), Cells(6, 60), Cells(7, 60), Cells(8, 60), Cells(9, 60), Cells(10, 60), Cells(11, 60), Cells(12, 60), Cells(13, 60), Cells(14, 60), Cells(15, 60), Cells(16, 60), Cells(17, 60), Cells(18, 60), Cells(19, 60), Cells(20, 60), Cells(21, 60), Cells(22, 60), Cells(23, 60), Cells(24, 60), Cells(25, 60), Cells(26, 60), Cells(27, 60), Cells(28, 60), Cells(29, 60), Cells(30, 60), Cells(31, 60), Cells(32, 60), Cells(33, 60), Cells(34, 60), Cells(35, 60), Cells(36, 60), Cells(37, 60), Cells(38, 60), Cells(39, 60), Cells(40, 60), Cells(41, 60), Cells(42, 60), Cells(43, 60), Cells(44, 60), Cells(45, 60), Cells(46, 60), Cells(47, 60), Cells(48, 60), Cells(49, 60), Cells(50, 60), Cells(51, 60), Cells(52, 60), Cells(53, 60), Cells(54, 60), Cells(55, 60), Cells(56, 60), Cells(57, 60), Cells(58, 60), Cells(59, 60), Cells(60, 60), Cells(61, 60), Cells(62, 60), Cells(63, 60), Cells(64, 60), Cells(65, 60), Cells(66, 60), Cells(67, 60), Cells(68, 60))
With Worksheets("zero")
    .Cells.Clear
    j = 1
    For i = 0 To UBound(MyArr)
    Set Found_b = Columns("A:B").Find(MyArr(i), , xlValues, xlWhole)
    iAdr = Found_b.Address
        k = 1
        Do
        Range(Cells(Found_b.Row, 1), Cells(Found_b.Row, 26)).Copy .Cells(k, j)
        Set Found_b = Columns("A:B").FindNext(Found_b)
        k = k + 1
        Loop While Found_b.Address <> iAdr
        j = j + 27
    Next
End With
End Sub

[/vba]

Код

[/vba]zegor

Сообщение отредактировал zegor - Пятница, 10.08.2018, 16:48

Ответить

СообщениеПривет, excelworld. Есть макрос, он "блочно" перебрасывает данные с одного листа на другой по критериям (есть список). Собственно у меня получается охватывать только 67 критериев. При попытке добавить критерий заканчивается строка и последнее добавление окрашивается в красный цвет. Если это игнорировать макрос отказывается работать. Помоги пожалуйста преодолеть лимит в 67 критериев.
[vba]

Код