Условие на удаление строк

@Baykal555 · Регистрация: 08.09.2017

Студворк — интернет-сервис помощи студентам

Всем привет!
Задача следующая: необходимо удалить строки, если выполняются три условия:
1. рассматриваем только повторяющиеся значения по столбцам A,B,C
2. в пятом столбце есть значение "36"
3. и если в пятом столбце есть значение "A38", то нужно удалить именно эту строку
Пробовал написать такой код:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub RemoveRow()
    Cells.Sort Key1:=Range("A1")
    totalrows = ActiveSheet.UsedRange.Rows.Count
lastrow = cells(Rows.Count,1).End(Xlup).Count
For i = lastrow to 2 step -1
if cells(i,5) = 36
    For Row = totalrows To 2 Step -1
        If Cells(Row, 1).Value = Cells(Row - 1, 1).Value  and  Cells(Row, 2).Value = Cells(Row - 1, 2).Value and  Cells(Row, 3).Value = Cells(Row - 1, 3).Value Then
if cells(row,5) = "A38"
            Rows(Row).Delete
        End If
end if
    Next Row
end if 
next
End Sub

Но удаления не происходит. Подскажите, пожалуйста, как можно реализовать эту задачу. Файл с примером прилагаю (в фале выделил красным строку, которая должна в итоге удалиться).

Спасибо!

@Baykal555 · 21.01.2021, 15:04 **[ТС]**

Zeag, спасибо! сейчас попробую

@Narimanych · 21.01.2021, 16:28

Baykal555,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub Macro1()
LR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LR
  Cells(i, 8) = Cells(i, 1) & Cells(i, 2) & Cells(i, 3)
Next
Set R = Range(Cells(2.8), Cells(LR, 8))
For i = 2 To LR
  Cells(i, 9).Value = Application.WorksheetFunction.CountIf(R, Cells(i, 8).Value)
Next
 
For i = LR To 2 Step -1
If Cells(i, 9).Value > 1 And Cells(i, 5).Value = "A38" Then Rows(i).Delete
Next
   
LR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LR
  Cells(i, 8) = Cells(i, 1) & Cells(i, 2) & Cells(i, 3)
Next
Set R = Range(Cells(2.8), Cells(LR, 8))
 
For i = 2 To LR
    Cells(i, 9).Value = Application.WorksheetFunction.CountIf(R, Cells(i, 8).Value)
Next
   
For i = 2 To LR
   If Cells(i, 9).Value > 1 And Cells(i, 5).Value = 36 Then Cells(i, 4).Value = "AAA"
Next
Range(Cells(2, 8), Cells(LR, 9)).ClearContents
 
End Sub

@Baykal555 · 21.01.2021, 16:34 **[ТС]**

Narimanych, спасибо! Посмотрите, пожалуйста, код удаляет строку, несмотря на то, что 36 в пятом столбце отсутствует.

@Baykal555 · 21.01.2021, 16:56 **[ТС]**

Zeag, не понял как по блокам разбить

@Narimanych · 21.01.2021, 18:17

Baykal555,
Где в вашем файле 36?
P.S. Вы меня с каждым разом все больше и больше удивляете...\\
Код делает:

1. Снизу вверх ищет значение А38 в столбце 5...
2.Если значения в первых трех столбцах не единственные в своем роде- то найденная строка удаляется
3.Ищет значение 36 в столбце 5...
4.Если значения в первых трех столбцах не единственные в своем роде- то вместо 36 пишет ААА

Вы нигде не написали про удаление строка с чилом 36 в 5-м столбце, если вам необходимо удалить -
попробуйте повторить 1 часть кода самостоятельно....
Там ничего сложного нет..

Если что-тщ непонятно - есть гугл ..
Чуть подправил
код:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub Macro1()
LR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LR
  Cells(i, 8) = Cells(i, 1) & Cells(i, 2) & Cells(i, 3)
Next
Set R = Range(Cells(2.8), Cells(LR, 8))
For i = 2 To LR
  Cells(i, 9).Value = Application.WorksheetFunction.CountIf(R, Cells(i, 8).Value)
Next
 
For i = LR To 2 Step -1
If Cells(i, 9).Value > 1 And Cells(i, 5).Value = "A38" Then Rows(i).Delete
Next
   
LR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LR
  Cells(i, 8) = Cells(i, 1) & Cells(i, 2) & Cells(i, 3)
Next
Set R = Range(Cells(2.8), Cells(LR, 8))
 
For i = 2 To LR
    Cells(i, 9).Value = Application.WorksheetFunction.CountIf(R, Cells(i, 8).Value)
Next
   
For i = 2 To LR
   If Cells(i, 9).Value > 1 And Cells(i, 5).Value = 36 Then Cells(i, 5).Value = "AAA"
Next
Range(Cells(2, 8), Cells(LR, 9)).ClearContents
 
End Sub

Проверил у себя - все работает...
Попробуйте вникнуть в код, а не ждать готовых решений...
Посмотрите , для чего я использовал
For i = 2 To LR
Cells(i, 9).Value = Application.WorksheetFunction.CountIf(R, Cells(i, 8).Value)
Next

@Baykal555 · 21.01.2021, 22:00 **[ТС]**

Narimanych, прочитайте внимательно мое сообщение. В том-то и дело, что 36 нигде и не было. Я написал, что 36 в файле нет, но код строку с A38 удалил. В предыдущих сообщениях я писал, что удаление строки с А38 должно быть только при условии наличия значения 36. За помощь спасибо! Буду пытаться вникнуть в ваш код.

@Narimanych · 21.01.2021, 22:05

Baykal555,

Вот это что означает?

Объясните плиз:

Сообщение от Baykal555

в пятом столбце есть значение "36"
3. и если в пятом столбце есть значение "A38", то нужно удалить именно эту строку

Что вы хотите конкретно...

как это по -русски , что бы и я понял?

@Baykal555 · 21.01.2021, 22:09 **[ТС]**

Narimanych, то, что, если в пятом столбце присутствует значение 36 по ранее выделенному диапазону, то при наличии в этом же столбце значения А38, удалить его. А в этом сообщении я написал, что попробовал ваш код на примере, когда 36 в пятом столбце нет

Сообщение от Baykal555

Посмотрите, пожалуйста, код удаляет строку, несмотря на то, что 36 в пятом столбце отсутствует.

но код строку с А38 все равно удалил

@Narimanych · 21.01.2021, 23:12

Baykal555,

А....понял... сенкс...щас попробую..

Добавлено через 38 минут
Baykal555,
Ну вроде сделал....
С помощью словаря , массивов
1) Не надо сортировать
2) Нет удаления строк- Диапазон в массивы - манипуляции и в финале - массив в диапазон.. Увеличивается скорость..
3) Учтены ваши хотелки. А именно:
Если в 3-х столбцах одинаковые значения , то проверяем для этой круппы совпадений - содержит ли столбец 5 в данной группе число 36 .Если да , то проверяем содержит ли столбец 5 в данной группе "А38" б если да - то убираем строку

Попробуйте и отпишитесь . Жду...

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub MMM()
LR = Cells(Rows.Count, 1).End(xlUp).Row
ARR1 = Range(Cells(2, 1), Cells(LR, 5)).Value
ReDim ARR2(1 To UBound(ARR1), 1 To UBound(ARR1, 2))
ReDim ARR3(1 To UBound(ARR1))
 
 
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(ARR1)
        ARR3(i) = ARR1(i, 1) & ARR1(i, 2) & ARR1(i, 3)
        LL = .Item(ARR3(i))
    Next
    ReDim KL(.Count)
    For i = 0 To .Count - 1
       For j = 1 To UBound(ARR1)
        If .keys()(i) = ARR3(j) Then KL(i) = True
       Next
    Next
    
    For i = 0 To .Count - 1
        For j = 1 To UBound(ARR1)
         If .keys()(i) = ARR3(j) And KL(i) = True Then
            If ARR1(j, 5) = "A38" Then ARR1(j, 1) = 0
         End If
       Next
    Next
End With
 
 M = 1
 For i = 1 To UBound(ARR1)
  If ARR1(i, 1) <> 0 Then
     For j = 1 To UBound(ARR1, 2)
        ARR2(M, j) = ARR1(i, j)
     Next
     M = M + 1
  End If
 Next
 
' Вывод на лист 2
Sheets(2).Range("A2").Resize(UBound(ARR1), UBound(ARR1, 2)).Value = ARR2
 
 
' если хотите на тот же лист , то вот этот вариант
'_________________________________________________
 
Range("A2").Resize(UBound(ARR1), UBound(ARR1, 2)).Value = ARR2
End Sub

@Baykal555 · 21.01.2021, 23:17 **[ТС]**

Narimanych, попробовал в том же файле, строка с А38 удалилась, хотя 36 не было

@Narimanych · 21.01.2021, 23:25

Baykal555,

Сорри, маленкий нюанс ... Исправил.. ДолжОн работАть

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub MMM()
LR = Cells(Rows.Count, 1).End(xlUp).Row
ARR1 = Range(Cells(2, 1), Cells(LR, 5)).Value
ReDim ARR2(1 To UBound(ARR1), 1 To UBound(ARR1, 2))
ReDim ARR3(1 To UBound(ARR1))
 
 
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(ARR1)
        ARR3(i) = ARR1(i, 1) & ARR1(i, 2) & ARR1(i, 3)
        LL = .Item(ARR3(i))
    Next
    ReDim KL(.Count)
    For i = 0 To .Count - 1
       For j = 1 To UBound(ARR1)
        If .keys()(i) = ARR3(j) Then
             If ARR1(j, 5) = 36 Then KL(i) = True
        End If
       Next
    Next
    
    For i = 0 To .Count - 1
        For j = 1 To UBound(ARR1)
         If .keys()(i) = ARR3(j) And KL(i) = True Then
            If ARR1(j, 5) = "A38" Then ARR1(j, 1) = 0
         End If
       Next
    Next
End With
 
 M = 1
 For i = 1 To UBound(ARR1)
  If ARR1(i, 1) <> 0 Then
     For j = 1 To UBound(ARR1, 2)
        ARR2(M, j) = ARR1(i, j)
     Next
     M = M + 1
  End If
 Next
 
' Вывод на лист 2
Sheets(2).Range("A2").Resize(UBound(ARR1), UBound(ARR1, 2)).Value = ARR2
 
 
' если хотите на тот же лист , то вот этот вариант
'_________________________________________________
 
Range("A2").Resize(UBound(ARR1), UBound(ARR1, 2)).Value = ARR2
End Sub

@Baykal555 · 21.01.2021, 23:27 **[ТС]**

Narimanych, спасибо огромное!!! Все работает! Буду изучать код.

@Narimanych · 21.01.2021, 23:29

Baykal555,
Удачи...

Новые блоги и статьи Все статьи Все блоги /
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" Adler 06.10.2026 Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391
	21.01.2021, 15:04 [ТС]
	Zeag, спасибо! сейчас попробую 0

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391
	21.01.2021, 16:56 [ТС]
	Zeag, не понял как по блокам разбить 0

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391
	21.01.2021, 22:00 [ТС]
	Narimanych, прочитайте внимательно мое сообщение. В том-то и дело, что 36 нигде и не было. Я написал, что 36 в файле нет, но код строку с A38 удалил. В предыдущих сообщениях я писал, что удаление строки с А38 должно быть только при условии наличия значения 36. За помощь спасибо! Буду пытаться вникнуть в ваш код. 0

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391
	21.01.2021, 23:17 [ТС]
	Narimanych, попробовал в том же файле, строка с А38 удалилась, хотя 36 не было 0

@Baykal555 1 / 1 / 0 Регистрация: 08.09.2017 Сообщений: 391
	21.01.2021, 23:27 [ТС]
	Narimanych, спасибо огромное!!! Все работает! Буду изучать код. 0

@Narimanych 2752 / 1726 / 779 Регистрация: 23.03.2015 Сообщений: 5,452
	21.01.2021, 23:29
	Baykal555, Удачи... 1

Условие на удаление строк

Решение