На Листе3 - в столбце А - вписан текст разнообразной длины. В ячейку H3 - вписана допустимая длина строки (в данном случае - 29 символов). В диапазон J3:AC3 вписан текст, который исключает строки - которые начинаются с этого текста.
Как скопировать подходящий под условия текст из столбца А - на Лист4 в столбец B (начиная с ячейки B5) ? (То есть макрос исключает строки - с длиной, меньше чем указано в ячейке H3. А также исключает строки, которые начинаются с текста вписанного в диапазон J3:AC3. И копирует оставшиеся строки на Лист4.)
На Листе3 - в столбце А - вписан текст разнообразной длины. В ячейку H3 - вписана допустимая длина строки (в данном случае - 29 символов). В диапазон J3:AC3 вписан текст, который исключает строки - которые начинаются с этого текста.
Как скопировать подходящий под условия текст из столбца А - на Лист4 в столбец B (начиная с ячейки B5) ? (То есть макрос исключает строки - с длиной, меньше чем указано в ячейке H3. А также исключает строки, которые начинаются с текста вписанного в диапазон J3:AC3. И копирует оставшиеся строки на Лист4.)yl3d
With Sheets("Лист3") x = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Value aIsk = .Range("J3", .Cells(3, Columns.Count).End(xlToLeft)).Value lZ = .Range("H3") End With ReDim y(1 To UBound(x), 1 To 1)
For i = 1 To UBound(x) If Len(x(i, 1)) > lZ Then For j = 1 To UBound(aIsk, 2) If Left(x(i, 1), Len(aIsk(1, j))) = aIsk(1, j) Then GoTo Metka Next j k = k + 1: y(k, 1) = x(i, 1) End If Metka: Next i
With Sheets("Лист4") .Range("B5").CurrentRegion.ClearContents If k > 0 Then .Range("B5").Resize(k).Value = y() .Activate End With End Sub
[/vba]
yl3d, привет пробуйте
[vba]
Код
Sub ertert() Dim x, y(), i&, j&, lZ&, k&, aIsk
With Sheets("Лист3") x = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Value aIsk = .Range("J3", .Cells(3, Columns.Count).End(xlToLeft)).Value lZ = .Range("H3") End With ReDim y(1 To UBound(x), 1 To 1)
For i = 1 To UBound(x) If Len(x(i, 1)) > lZ Then For j = 1 To UBound(aIsk, 2) If Left(x(i, 1), Len(aIsk(1, j))) = aIsk(1, j) Then GoTo Metka Next j k = k + 1: y(k, 1) = x(i, 1) End If Metka: Next i
With Sheets("Лист4") .Range("B5").CurrentRegion.ClearContents If k > 0 Then .Range("B5").Resize(k).Value = y() .Activate End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
