Во вложении файл Excel, необходимо переносить строки (с удалением), начиная с 4-ой с Листа "КЗ" в Лист "КЗ (На корректировке)" при следующем условии: в столбце "E" соответствующей строки появляется слово "Корректировка".
Во вложении файл Excel, необходимо переносить строки (с удалением), начиная с 4-ой с Листа "КЗ" в Лист "КЗ (Аннулированные)" при следующем условии: в столбце "E" соответствующей строки появляется слово "Аннулирована".
Спасибо огромное!
Уважаемые форумчане, доброго дня.
Прошу помочь по следующему вопросу:
Во вложении файл Excel, необходимо переносить строки (с удалением), начиная с 4-ой с Листа "КЗ" в Лист "КЗ (На корректировке)" при следующем условии: в столбце "E" соответствующей строки появляется слово "Корректировка".
Во вложении файл Excel, необходимо переносить строки (с удалением), начиная с 4-ой с Листа "КЗ" в Лист "КЗ (Аннулированные)" при следующем условии: в столбце "E" соответствующей строки появляется слово "Аннулирована".
А просто автофильтром пользоваться по единственной таблице (первой) не хотите?
Плюс к этому явно напрашивается улучшение вашей таблицы в виде добавления в неё двух колонок, в одной из которых так и писать "Корректировка" или "Аннулирована", а во второй ставить дату этого события.
А просто автофильтром пользоваться по единственной таблице (первой) не хотите?
Плюс к этому явно напрашивается улучшение вашей таблицы в виде добавления в неё двух колонок, в одной из которых так и писать "Корректировка" или "Аннулирована", а во второй ставить дату этого события.Gustav
Sub tt() Dim ws1 As Worksheet, ws2 As Worksheet Dim Rng As Range Application.ScreenUpdating = False Set ws1 = Sheets("КЗ"): Set ws2 = Sheets("КЗ (На корректировке)") With ws1 Set Rng = .Range("A4:F" & .Cells(Rows.Count, 1).End(xlUp).Row) If .AutoFilterMode Then Rng.AutoFilter Field:=5 Rng.AutoFilter Field:=5, Criteria1:="Корректировка" On Error Resume Next Rng.SpecialCells(xlCellTypeVisible).Cut Destination:=ws2.Range("A" & ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1) If Err Then Err.Clear Else Rng.EntireRow.Delete shift:=xlShiftUp Application.CutCopyMode = False Rng.AutoFilter Field:=5 End With Application.ScreenUpdating = True End Sub
[/vba]
Пробуйте (для Аннулирования - по аналогии) [vba]
Код
Sub tt() Dim ws1 As Worksheet, ws2 As Worksheet Dim Rng As Range Application.ScreenUpdating = False Set ws1 = Sheets("КЗ"): Set ws2 = Sheets("КЗ (На корректировке)") With ws1 Set Rng = .Range("A4:F" & .Cells(Rows.Count, 1).End(xlUp).Row) If .AutoFilterMode Then Rng.AutoFilter Field:=5 Rng.AutoFilter Field:=5, Criteria1:="Корректировка" On Error Resume Next Rng.SpecialCells(xlCellTypeVisible).Cut Destination:=ws2.Range("A" & ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1) If Err Then Err.Clear Else Rng.EntireRow.Delete shift:=xlShiftUp Application.CutCopyMode = False Rng.AutoFilter Field:=5 End With Application.ScreenUpdating = True End Sub
For i = nRow To 4 Step -1 ' в цикле просматриваем столбец 5 снизу до верху таблички "КЗ". ' сделали два теста на искомые ключевые слова: a0 = Sheets("КЗ").Cells(i, 5).Value Like "*АННУЛИРОВАНА*" 'если есть искомое слово тогда флажок a0 = истина k0 = Sheets("КЗ").Cells(i, 5).Value Like "*КОРРЕКТИРОВКА*" 'то-же для другого слова ' ну и две проверки If a0 = True Then 'если флажок a0 = истина aRow = Sheets("КЗ (Аннулированные)").Cells(Rows.Count, 1).End(xlUp).Row + 1 'ищем свободную строку на листе "аннулированные" Sheets("КЗ").Rows(i).Cut 'копируем с листа "КЗ" строчку "i" Sheets("КЗ (Аннулированные)").Rows(aRow).Insert ' переносим её на лист "аннулированные" в строку "aRow" Sheets("КЗ").Rows(i).Delete Shift:=xlUp ' удаляем строчку "i" с листа "КЗ" со сдвигом ост строк в верх. End If
If k0 = True Then ' тут то-же для слова "Корректировка" kRow = Sheets("КЗ (На корректировке)").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("КЗ").Rows(i).Cut Sheets("КЗ (На корректировке)").Rows(kRow).Insert Sheets("КЗ").Rows(i).Delete Shift:=xlUp End If
Next i
End Sub
[/vba]
Вот, можно и так примерно, пробуйте:
[vba]
Код
Public Sub my_test()
Dim nRow As Long Dim aRow As Long Dim kRow As Long Dim i As Integer
For i = nRow To 4 Step -1 ' в цикле просматриваем столбец 5 снизу до верху таблички "КЗ". ' сделали два теста на искомые ключевые слова: a0 = Sheets("КЗ").Cells(i, 5).Value Like "*АННУЛИРОВАНА*" 'если есть искомое слово тогда флажок a0 = истина k0 = Sheets("КЗ").Cells(i, 5).Value Like "*КОРРЕКТИРОВКА*" 'то-же для другого слова ' ну и две проверки If a0 = True Then 'если флажок a0 = истина aRow = Sheets("КЗ (Аннулированные)").Cells(Rows.Count, 1).End(xlUp).Row + 1 'ищем свободную строку на листе "аннулированные" Sheets("КЗ").Rows(i).Cut 'копируем с листа "КЗ" строчку "i" Sheets("КЗ (Аннулированные)").Rows(aRow).Insert ' переносим её на лист "аннулированные" в строку "aRow" Sheets("КЗ").Rows(i).Delete Shift:=xlUp ' удаляем строчку "i" с листа "КЗ" со сдвигом ост строк в верх. End If
If k0 = True Then ' тут то-же для слова "Корректировка" kRow = Sheets("КЗ (На корректировке)").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("КЗ").Rows(i).Cut Sheets("КЗ (На корректировке)").Rows(kRow).Insert Sheets("КЗ").Rows(i).Delete Shift:=xlUp End If
А просто автофильтром пользоваться по единственной таблице (первой) не хотите?
Плюс к этому явно напрашивается улучшение вашей таблицы в виде добавления в неё двух колонок, в одной из которых так и писать "Корректировка" или "Аннулирована", а во второй ставить дату этого события.
А просто автофильтром пользоваться по единственной таблице (первой) не хотите?
Плюс к этому явно напрашивается улучшение вашей таблицы в виде добавления в неё двух колонок, в одной из которых так и писать "Корректировка" или "Аннулирована", а во второй ставить дату этого события.