Доброго времени суток форумчане. Прошу Вашего внимания и помощи в написании макроса. Есть таблица, в которой нужно ,построчно, сравнить ячейки с "Е" по "К" и если есть цифры идущие по порядку - отметить это в соседней таблице. В примере во второй строке в ячейках с Е2 по К2 последовательно идут числа 120 и 121, следовательно в соседней таблице отмечена ячейка в столбце "2 подряд".Таблица может содержать несколько тысяч строк. Смог, частично, организовать подобное с помощью формул, но только для 2-х подряд и 3-х подряд (вкладка "что смог").С макросами только начинаю разбираться. Буду признателен любой помощи.
Доброго времени суток форумчане. Прошу Вашего внимания и помощи в написании макроса. Есть таблица, в которой нужно ,построчно, сравнить ячейки с "Е" по "К" и если есть цифры идущие по порядку - отметить это в соседней таблице. В примере во второй строке в ячейках с Е2 по К2 последовательно идут числа 120 и 121, следовательно в соседней таблице отмечена ячейка в столбце "2 подряд".Таблица может содержать несколько тысяч строк. Смог, частично, организовать подобное с помощью формул, но только для 2-х подряд и 3-х подряд (вкладка "что смог").С макросами только начинаю разбираться. Буду признателен любой помощи.Uchenik11
Sub ertert() Dim x, i&, j&, k&, y() With Sheets("Пример") x = .Range("E2:K" & .Cells(Rows.Count, 5).End(xlUp).Row).Value End With ReDim y(1 To UBound(x), 1 To 6)
With CreateObject("System.Collections.ArrayList") For i = 1 To UBound(x) For j = 1 To UBound(x, 2) .Add x(i, j) Next j .Sort k = 0 For j = 1 To .Count - 1 If .Item(j) = .Item(j - 1) + 1 Then k = k + 1 Else If k > 0 Then y(i, k) = y(i, k) + 1: k = 0 End If Next j .Clear Next i End With Range("Q2").Resize(UBound(y), UBound(y, 2)).Value = y() End Sub
[/vba]
Uchenik11, привет попробуйте так
[vba]
Код
Sub ertert() Dim x, i&, j&, k&, y() With Sheets("Пример") x = .Range("E2:K" & .Cells(Rows.Count, 5).End(xlUp).Row).Value End With ReDim y(1 To UBound(x), 1 To 6)
With CreateObject("System.Collections.ArrayList") For i = 1 To UBound(x) For j = 1 To UBound(x, 2) .Add x(i, j) Next j .Sort k = 0 For j = 1 To .Count - 1 If .Item(j) = .Item(j - 1) + 1 Then k = k + 1 Else If k > 0 Then y(i, k) = y(i, k) + 1: k = 0 End If Next j .Clear Next i End With Range("Q2").Resize(UBound(y), UBound(y, 2)).Value = y() End Sub
Позвольте оторвать ещё немного Вашего драгоценного времени, уважаемые форумчане. Задачка из комбинаторики, но тоже на поиск значений по порядку. Есть макрос, который выполняет сочетание без повторений и выводит все варианты на лист. Нужно, чтобы он выводил только варианты содержащие определённые числа (в примере это числа 1 и 2, которые были введены в ячейки выше кнопки "Нажми" на листе "Пример") и если количество строк на листе не хватает, то продолжал бы на другом листе. На "Лист 1" - макрос. Самому не решить.
Позвольте оторвать ещё немного Вашего драгоценного времени, уважаемые форумчане. Задачка из комбинаторики, но тоже на поиск значений по порядку. Есть макрос, который выполняет сочетание без повторений и выводит все варианты на лист. Нужно, чтобы он выводил только варианты содержащие определённые числа (в примере это числа 1 и 2, которые были введены в ячейки выше кнопки "Нажми" на листе "Пример") и если количество строк на листе не хватает, то продолжал бы на другом листе. На "Лист 1" - макрос. Самому не решить.Uchenik11
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
