Привет, 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]
Привет, 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