Помогите решить проблему, есть рабочий модуль который переносит строки с одного листа книги на другой исходя из заданного условия. [vba]
Код
Sub Строки_титул() Application.ScreenUpdating = False
lr = Sheets("вып").Cells(Rows.Count, 2).End(xlUp).Row If Sheets("вып").Cells(2, 2) = "" Then lr = 2 Else: lr = Sheets("вып").Cells(Rows.Count, 2).End(xlUp).Row + 1 End If For i = Cells(Rows.Count, 48).End(xlUp).Row To 2 Step -1 If Cells(i, 48) = "готов" Then Range(Cells(i, "A"), Cells(i, "AX")).Copy Sheets("вып").Range("A" & lr) Rows(i).Delete lr = lr + 1 End If Next
For i = Cells(Rows.Count, 47).End(xlUp).Row To 2 Step -1 If Cells(i, 47) = "готов" Then Range(Cells(i, "A"), Cells(i, "AX")).Copy Sheets("вып").Range("A" & lr) Rows(i).Delete lr = lr + 1 End If Next Application.ScreenUpdating = True MsgBox "Строки с готовой продукцией успешно перенесены на лист (вып)" End Sub
[/vba] подскажите с помощью какого модуля можно перемещать строки в верх в пределах одного листа по условию: если в столбце I статус заказа - готов, то строка с диапазоном столбцов от А до I должна переместиться на 2 строку листа при условии что она пуста. Если строка занята то добавить на следующую пустую после второй.
Помогите решить проблему, есть рабочий модуль который переносит строки с одного листа книги на другой исходя из заданного условия. [vba]
Код
Sub Строки_титул() Application.ScreenUpdating = False
lr = Sheets("вып").Cells(Rows.Count, 2).End(xlUp).Row If Sheets("вып").Cells(2, 2) = "" Then lr = 2 Else: lr = Sheets("вып").Cells(Rows.Count, 2).End(xlUp).Row + 1 End If For i = Cells(Rows.Count, 48).End(xlUp).Row To 2 Step -1 If Cells(i, 48) = "готов" Then Range(Cells(i, "A"), Cells(i, "AX")).Copy Sheets("вып").Range("A" & lr) Rows(i).Delete lr = lr + 1 End If Next
For i = Cells(Rows.Count, 47).End(xlUp).Row To 2 Step -1 If Cells(i, 47) = "готов" Then Range(Cells(i, "A"), Cells(i, "AX")).Copy Sheets("вып").Range("A" & lr) Rows(i).Delete lr = lr + 1 End If Next Application.ScreenUpdating = True MsgBox "Строки с готовой продукцией успешно перенесены на лист (вып)" End Sub
[/vba] подскажите с помощью какого модуля можно перемещать строки в верх в пределах одного листа по условию: если в столбце I статус заказа - готов, то строка с диапазоном столбцов от А до I должна переместиться на 2 строку листа при условии что она пуста. Если строка занята то добавить на следующую пустую после второй.joey
дело в том что заказов со статусом готов может быть более 100 и они могут быть раскиданы по всему листу в перемешку с остальными заказами, фильтр не подходит, мне нужно сразу видеть все заказы этого листа. а если вторая строка уже занята, то на следующую пустую после нее, выше писал уже.
дело в том что заказов со статусом готов может быть более 100 и они могут быть раскиданы по всему листу в перемешку с остальными заказами, фильтр не подходит, мне нужно сразу видеть все заказы этого листа. а если вторая строка уже занята, то на следующую пустую после нее, выше писал уже.joey
Private Sub Worksheet_Change(ByVal Target As Range) Dim r& r = Target.Row If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("I:I")) Is Nothing Then If Cells(r, 9).Value = "готов" Then Rows(r).Cut [A1].CurrentRegion.Offset(1).Insert End If End If End Sub
[/vba] Выделять каждую строчку для переноса joey навряд ли будет, если я правильно понял нужно строки переносить при изменении статуса на "готов"? Кажется, определились и с третьей и с четвертой
Тады ой-ё-ёй! В модуль листа: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim r& r = Target.Row If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("I:I")) Is Nothing Then If Cells(r, 9).Value = "готов" Then Rows(r).Cut [A1].CurrentRegion.Offset(1).Insert End If End If End Sub
[/vba] Выделять каждую строчку для переноса joey навряд ли будет, если я правильно понял нужно строки переносить при изменении статуса на "готов"? Кажется, определились и с третьей и с четвертой _Igor_61
У меня все работает. Покажите не скрин, а проблемный файл. Возможно, он чем-то отличает ся от примера или еще какой-то макрос у Вас там есть... А возможно Вы меняете статус во второй строке... Тогда в код можно добавить проверку:[vba]
Код
....... If Not Intersect(Target, Range("I:I")) Is Nothing Then If r = 2 Then Exit Sub End If If Cells(r, 9).Value = "готов" Then и т.д.
[/vba]
У меня все работает. Покажите не скрин, а проблемный файл. Возможно, он чем-то отличает ся от примера или еще какой-то макрос у Вас там есть... А возможно Вы меняете статус во второй строке... Тогда в код можно добавить проверку:[vba]
Код
....... If Not Intersect(Target, Range("I:I")) Is Nothing Then If r = 2 Then Exit Sub End If If Cells(r, 9).Value = "готов" Then и т.д.
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
