Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Удаление строк по условию
 
#1
11.12.2019 20:37:54

Вечер добрый гуру мастера спасибо Вам, что Вы есть, возникла такая в кратце проблема, есть таблица «Учет» на нем две кнопки с макросами, нужно макрос доработать таким образом если:

В столбце А7 (СТАТУС) в выпадающем списке выбрать «4К» а в столбце Е7 (категория) в выпадающем списке выбрать «СТ»

плюс

В столбце А8 (СТАТУС) в выпадающем списке выбрать «4К» а в столбце Е8 (категория) в выпадающем списке выбрать «ВО»

При выполнении макроса значения скопируются каждый в свою таблицу  4КАТСТ , 4КАТВО с наполнениями этих таблиц без копирования таблиц, т.е копирования значений. Прежде чем вникнуть в суть посмотрите саму таблицу и как работает макрос в нем.

Один макрос раскидывает по таблицам по условию 4К и в столбеце Е8 (Категория) ВО в 4КАТВО, СТ в 4КАТСТ, и т. д

Изменено: Zetrox_95 - 11.12.2019 20:44:31
 
 
 
#2
12.12.2019 13:26:25
Мне кажется Вам надо в платную ветку. Или обратитесь к тому, кто это писал. Ковыряться в чужом коде не хочется, да и не этично это. А в платной ветке, объясните, что нужно и Вам с нуля все напишут.
 
 
 
#3
13.12.2019 15:39:34
Благо сам разобрался, но теперь другая задача нарисовалась, теперь рассортировка работает как надо, единственное доработал в макросе условие при нажатии кнопки 4КАТЕГОРИЯ на листе УЧЁТ, выставить (статус) "4К", (категория) "СТ" то целая строка А:AYпереносит все значения на лист 4КАТСТ при переносе добавил функцию удаления строк из листа УЧЁТ вроде все работает, но удаление строк останавливается приходится по несколько раз нажимать
 
 
 
#4
13.12.2019 15:49:20
Код
Sub РАБОТА()
Dim LastRow As Long, Rw As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("4КАТСТ")
        Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        For i = LastRow To 7 Step -1
            If Cells(i, 1) = "4К" And Cells(i, 5) = "СТ" Then
                Range(Cells(i, 1), Cells(i, 52)).Copy .Cells(Rw, 1)
                Rw = Rw + 1
                Range(Cells(i, 1), Cells(i, 52)).Delete Shift:=xlUp
                End If
        Next
    End With
End Sub
Ты её переверни )
 
 
 
#5
13.12.2019 16:00:31
В смысле, перевернуть?  
 
 
 
#6
13.12.2019 16:02:19
Код из #5 работает?
 
 
 
#7
13.12.2019 16:08:03
Цитата
Zetrox_95 написал:
Автоматизация макрос в таблице учёта
Zetrox_95, макрос - это всегда автоматизация. Проблем а в чём? Вот это и нужно кратко формулировать в названии темы.
Цитата
Zetrox_95 написал:
По ходу задачка сложна
С простой Вы бы справились и самостоятельно )) Но такая фраза сродни попытке взять "на слабо". А здесь не любят это.
Цитата
Zetrox_95 написал:
теперь другая задача нарисовалась
И теперь ВСЕ Ваши задачи будем решать в одной теме? Разные задачи - разные темы. Об этом и в правилах есть.
 
 
 
#8
13.12.2019 16:09:38
Юрий здравствуйте, простите за тафталогию, прошу прощения если кого-то задел, своими словами.  
 
 
 
#9
13.12.2019 16:11:50
Юрий кстати спасибо Вам это ваши наработки в макросе, но не могли бы Вы мне помочь?
 
 
 
#10
13.12.2019 16:23:42
Привет! Сейчас нет возможности. Может ещё кто-нибудь подключится...
А вариант из #5 не помогает?
 
 
 
#11
13.12.2019 16:33:55
Вариант 5, из макрос имеете ввиду?  
 
 
 
#12
13.12.2019 16:50:39
Цитата
МатросНаЗебре написал:
Код из #5 работает?
 
 
 
#13
13.12.2019 17:27:22
Да работает если про строку  "Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1" то да, на листе 4КАТСТ ищет первую свободную строку  
 
 
 
#14
17.12.2019 10:23:33
День добрый товарищи хочу немного озадачить Вас, доработал код по удалению строк по условию если в строке 7 столбца А встречается слово "4КАТ" а в строке 7 столбца Е слово "СТ" то при выполнении макроса удаляется строка именно по такому условию. Но вопрос встал так, макрос выполняет цикл удаляет часть данных по условию прерывает работу и приходится повторно его его запускать, в чем может быть дело?
Код
Sub РАБОТА()
Dim LastRow As Long, Rw As Long
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("4КАТСТ")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 7 To LastRow
If Cells(i, 1) = "4К" And Cells(i, 5) = "СТ" Then
Range(Cells(i, 1), Cells(i, 52)).Copy .Cells(Rw, 1)
Rw = Rw + 1
End If
Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If Cells(i, 1) = "4К" And Cells(i, 5) = "СТ" Then
Range(Cells(i, 1), Cells(i, 52)).Delete Shift:=xlUp
End If
Next
End With
Application.ScreenUpdating = True
MsgBox "Готово", vbInformation
End Sub
Изменено: Zetrox_95 - 17.12.2019 10:43:57
 
 
 
#15
17.12.2019 11:26:39
Я один упорно не вижу кода в #5???

UPD: Zetrox_95, не надо мне в личку по вопросам из темы писать…
Судя по тому, что вы были удивлены "что не так с кодом 5", есть какой-то список кодов (в одном из файлов) и вы имели ввиду код из этого списка. Обычно же на форуме фраза "код из #5" произносится как "код из поста номер 5". П посте №5 никакого кода нет - вот я и удивился…

P.S.: во избежание подобных непоняток и просто для облегчения работы помогающим все коды (или основные из них) рекомендуется размещать в постах, оформив соответствующим тэгом "<…>" (если большие, то ещё и под спойлерами)
Изменено: Jack Famous - 17.12.2019 11:57:15
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#16
17.12.2019 18:38:54
Можно закрывать тему вопрос решил самостоятельно!
 
 
 
#17
17.12.2019 19:55:40
Так поняли почему цикл нужно перевернуть, или скоро опять будет повторять вопросы?
 
 
 
#18
17.12.2019 20:52:25
Цитата
Hugo написал:
Так поняли почему цикл нужно перевернуть, или скоро опять будет повторять вопросы?
Цикл не перевернул.  
Изменено: Zetrox_95 - 17.12.2019 20:54:40
 
 
 
#19
17.12.2019 20:56:40
Какие-то некоторые нервные и надменные тут.  
Изменено: Zetrox_95 - 17.12.2019 21:02:54
 
 
 
Страницы: 1
Наверх