Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Перенос строки по условию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Перенос строки по условию
Oh_Nick Дата: Вторник, 02.03.2021, 18:14 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
Всем доброго времени суток!

Имеется 6 листов: Export, Import, Local, Closed Export, Closed Local, Closed Import

Как мне при условии, если в последней колонке будет написано "Не нужно" - перенести эту строку в Closed.

Например в Local пишем в конце строчки "Не нужно" и она переносится в конец Closed local.
К сообщению приложен файл: PROJECTS-Copy.xlsm (27.9 Kb)
 
Ответить
СообщениеВсем доброго времени суток!

Имеется 6 листов: Export, Import, Local, Closed Export, Closed Local, Closed Import

Как мне при условии, если в последней колонке будет написано "Не нужно" - перенести эту строку в Closed.

Например в Local пишем в конце строчки "Не нужно" и она переносится в конец Closed local.

Автор - Oh_Nick
Дата добавления - 02.03.2021 в 18:14
_Igor_61 Дата: Вторник, 02.03.2021, 23:47 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 504
Репутация: 90 ±
Замечаний: 0% ±

Excel 2007
Oh_Nick, проблема в том, что слово "переносится" можно понимать по разному. Для одних это - скопировать и вставить, для других - вырезать и вставить. Посмотрите вариант с копированием, при необходимости замену копирования на вырезание доделаете сами. В модули листов Export, Import и Local:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
        Dim tr&, r&, n$
        tr = Target.Row
        n = ActiveSheet.Name
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range(tr & ":" & tr)) Is Nothing Then
On Error GoTo Er1
    tr = Range(tr & ":" & tr).Find(What:="Не нужно").Row
    Rows(tr).Copy
    Sheets("CLOSED " & n).Select
    r = Sheets("CLOSED " & n).UsedRange.Rows.Count
    Sheets("CLOSED " & n).Rows(r + 1).Select
    ActiveSheet.Paste
    Sheets(n).Select
    Application.CutCopyMode = False
End If
Exit Sub
Er1:
End Sub
[/vba]
 
Ответить
СообщениеOh_Nick, проблема в том, что слово "переносится" можно понимать по разному. Для одних это - скопировать и вставить, для других - вырезать и вставить. Посмотрите вариант с копированием, при необходимости замену копирования на вырезание доделаете сами. В модули листов Export, Import и Local:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
        Dim tr&, r&, n$
        tr = Target.Row
        n = ActiveSheet.Name
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range(tr & ":" & tr)) Is Nothing Then
On Error GoTo Er1
    tr = Range(tr & ":" & tr).Find(What:="Не нужно").Row
    Rows(tr).Copy
    Sheets("CLOSED " & n).Select
    r = Sheets("CLOSED " & n).UsedRange.Rows.Count
    Sheets("CLOSED " & n).Rows(r + 1).Select
    ActiveSheet.Paste
    Sheets(n).Select
    Application.CutCopyMode = False
End If
Exit Sub
Er1:
End Sub
[/vba]

Автор - _Igor_61
Дата добавления - 02.03.2021 в 23:47
Oh_Nick Дата: Среда, 03.03.2021, 09:26 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
_Igor_61, спасибо. Немного модернизировал:

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If (Target.Cells.Count > 1) Then Exit Sub
    On Error GoTo Er1
    
    If ((Target.Value = "Не нужно") And (Target.Column = 34)) Then
        Rows(Target.Row).Copy
        ActiveWorkbook.Sheets(4).Rows(ActiveWorkbook.Sheets(4).UsedRange.Rows.Count + 1).Insert
        Rows(Target.Row).Delete
    End If
    
    On Error GoTo 0
Er1:
    Exit Sub
End Sub
[/vba]

Привязал к каждому листу и колонке.
 
Ответить
Сообщение_Igor_61, спасибо. Немного модернизировал:

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If (Target.Cells.Count > 1) Then Exit Sub
    On Error GoTo Er1
    
    If ((Target.Value = "Не нужно") And (Target.Column = 34)) Then
        Rows(Target.Row).Copy
        ActiveWorkbook.Sheets(4).Rows(ActiveWorkbook.Sheets(4).UsedRange.Rows.Count + 1).Insert
        Rows(Target.Row).Delete
    End If
    
    On Error GoTo 0
Er1:
    Exit Sub
End Sub
[/vba]

Привязал к каждому листу и колонке.

Автор - Oh_Nick
Дата добавления - 03.03.2021 в 09:26
_Igor_61 Дата: Среда, 03.03.2021, 18:04 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 504
Репутация: 90 ±
Замечаний: 0% ±

Excel 2007
Привязал к каждому листу и колонке
Поздравляю! Нафига тогда Вы показывали в примере, что "Не нужно" на разных листах находится в разных столбцах и зависимость названия листов между исходными и конечными ("Closed")? Т.е. получается, Вы уже знали, как определить строку в нужном столбце и программные имена листов? Это троллинг такой? Извините за отнятое у Вас время. Не в обиду, просто формулируйте свои задачи конкретней, в т.ч. и в файлах-примерах. И на будущее: пробелы в названиях листов нежелательны.


Сообщение отредактировал _Igor_61 - Среда, 03.03.2021, 18:50
 
Ответить
Сообщение
Привязал к каждому листу и колонке
Поздравляю! Нафига тогда Вы показывали в примере, что "Не нужно" на разных листах находится в разных столбцах и зависимость названия листов между исходными и конечными ("Closed")? Т.е. получается, Вы уже знали, как определить строку в нужном столбце и программные имена листов? Это троллинг такой? Извините за отнятое у Вас время. Не в обиду, просто формулируйте свои задачи конкретней, в т.ч. и в файлах-примерах. И на будущее: пробелы в названиях листов нежелательны.

Автор - _Igor_61
Дата добавления - 03.03.2021 в 18:04
Oh_Nick Дата: Четверг, 04.03.2021, 08:41 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
_Igor_61, Спасибо, учту!
 
Ответить
Сообщение_Igor_61, Спасибо, учту!

Автор - Oh_Nick
Дата добавления - 04.03.2021 в 08:41
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!