Макросы удалить значения в excel

 

Здравствуйте, уважаемые форумчане! Помогите, пожалуйста, написать макрос. Суть такая:
Есть табличка, с таким диапазоном — A6:F505. Туда будут копироваться данные из другой программы. Нужен макрос (под кнопку из фигуры), который будет очищать данные в каждой строке данного диапазона, если хотя бы одна ячейка данной строки пустая. То есть, допустим, если в строке A6:F6 есть хотя бы одна пустая ячейка, то должна очищаться вся строка (имею в виду не удаление строки, а удаление данных из всех ячеек этой строки).
А затем, чтобы образовавшиеся пустые строки тоже удалялись. Опять же, желательно не удаление всей строки, а каким-то другим способом это делать… Возможно, сдвиг значений из нижерасположенной строчки или еще как-то. Главное, чтобы в таблице осталось фиксированное число строк, именно в этом диапазоне и именно с конкретной стилистикой. И все это действие должно происходить на одном листе.
Если такое можно сделать без 100 грамм и десятков часов кропотливой работы, был бы очень признателен))

Пример прилагаю. Там на листе1 выборка исходных данных, а на листе2 то, что должно получиться после работы макроса.

Прикрепленные файлы

  • Пример.xlsx (28.92 КБ)

 

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#2

21.05.2017 18:59:21

Код
Sub DelRowsWithBlankCell()
  On Error Resume Next
  Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

flashertheone

Пользователь

Сообщений: 104
Регистрация: 12.05.2016

#3

21.05.2017 19:04:16

Цитата
Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

Этот макрос все же удаляет пустые строки, а нужно, чтобы не удалял, а сдвигал значения из последующей строки на пустую (если такое возможно). Грубо говоря, чтобы между первой и последней строчкой таблицы не было пустых строк. Ну а в целом, если не получится осуществить задуманное, возьму Ваш макрос, спасибо.

Изменено: flashertheone21.05.2017 19:06:21

 

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#4

21.05.2017 19:21:16

добавим пару строк:

Код
Sub DelRowsWithBlankCell()
  Dim rg As Range:  On Error Resume Next
  With Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow
    If Err = 0 Then .ClearContents: .Copy Cells(506, 1): .Delete
  End With
End Sub

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

#5

21.05.2017 19:29:29

Цитата
flashertheone написал:
если в строке A6:F6 есть хотя бы одна пустая ячейка, то должна очищаться вся строка (имею в виду не удаление строки, а удаление данных из всех ячеек этой строки).
А затем, чтобы образовавшиеся пустые строки тоже удалялись.

Если в итоге эта строка удаляется, то зачем нужна её предварительная очистка?

 

flashertheone

Пользователь

Сообщений: 104
Регистрация: 12.05.2016

#6

21.05.2017 19:39:16

Ігор Гончаренко

Почти то, что надо, но, похоже, придется добавить еще пару строк)))
До применения макроса все строки, начиная с 506-ой были скрыты, а после — открылись все…
Все бы ничего, но требуется сохранить нужную стилистику таблицы, в том числе и количество скрытых строк.
То есть, Вашему макросу надо бы добавить команду, чтобы он скрывал опять все строки, начиная с 506-ой. Ну или поменять алгоритм его выполнения, тут я не знаю, как Вам удобнее…

Юрий М

Вы выдернули из контекста отрывок, не дочитав до конца =)
Я писал :

Цитата
А затем, чтобы образовавшиеся пустые строки тоже удалялись. Опять же, желательно не удаление всей строки, а каким-то другим способом это делать…
 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

#7

21.05.2017 19:45:21

Нет, я дочитал ))

Цитата
flashertheone написал:
образовавшиеся пустые строки тоже удалялись. Опять же, желательно не удаление всей строки, а каким-то другим способом это делать

Вот это никак не могу понять: строка или удаляется совсем (тогда не нужна очистка), или не удаляется )
Покажите в своём файле таблицу ДО и ПОСЛЕ.

 

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#8

21.05.2017 19:47:35

3-й вариант… зачетный

Код
Sub DelRowsWithBlankCell()
  Dim rg As Range: On Error Resume Next
  With Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow
    If Err = 0 Then .ClearContents: Intersect(.Cells, Range("A:F")).Copy Cells(506, 1): .Delete
  End With
End Sub

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 
Юрий М

Строка не удаляется.
В примере таблицы именно так и показано =)
Как было 500 открытых строк (A6:F505), так и должно остаться, с сохранением стилей.

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

#10

21.05.2017 19:52:12

Цитата
flashertheone написал:
Строка не удаляется.
В примере таблицы именно так и показано =)

В примере есть две строки с жёлтыми ячейками. Это ДО. А КАК должно получится ПОСЛЕ?
Впрочем, если Игорь понял объяснения, то можно на мой вопрос не отвечать :)

 

flashertheone

Пользователь

Сообщений: 104
Регистрация: 12.05.2016

#11

21.05.2017 19:54:38

Цитата
3-й вариант… зачетный

Эффект тот же, что и от второго варианта, не скрывает лишние строки…

 
flashertheone

,
откройте исходный файл, посмотрите а строку 506, она видна?
выполните макрос, что в файле после выполнения макроса стало не не так как ожидалось?

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 
Ігор Гончаренко

Исходный файл или пример, который я прикрепил?
Я выполняю каждый Ваш макрос и смотрю результат.
После выполнения последнего макроса видна и 506-я строка и последующие…

 

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#14

21.05.2017 20:14:59

Цитата
откройте исходный файл, посмотрите а строку 506, она видна?

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

flashertheone

Пользователь

Сообщений: 104
Регистрация: 12.05.2016

#15

21.05.2017 20:24:40

Цитата
откройте исходный файл, посмотрите а строку 506, она видна?

У меня не видна, и не должна быть видна. Может, не тот файл прикрепил. Прикрепляю еще раз…
Ваш последний макрос скрывает все пустые строки в диапазоне A6:F505, а начиная с 506-й строки наоборот открывает…
Еще раз попробую объяснить:
Есть 500 строк (A6:F505). Нужно, чтобы в этом диапазоне они были открыты, а начиная с 506-й — скрыты.

Прикрепленные файлы

  • Пример1.xlsx (28.99 КБ)

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

#16

21.05.2017 20:55:04

Может циклом? Обрамление ячеек можно потом добавить на весь диапазон.

Код
Sub Macro1()
Dim LastRow As Long, i As Long, Rng As Range
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set Rng = Range(Cells(LastRow + 1, 1), Cells(LastRow + 1, 6))
    For i = LastRow To 6 Step -1
        If Application.WorksheetFunction.CountBlank(Range(Cells(i, 1), Cells(i, 6))) > 0 Then
            Range(Cells(LastRow, 1), Cells(i + 1, 6)).Cut Cells(i, 1)
        End If
    Next
End Sub
 

flashertheone

Пользователь

Сообщений: 104
Регистрация: 12.05.2016

#17

21.05.2017 21:02:19

Цитата
Может циклом? Обрамление ячеек можно потом добавить на весь диапазон.

Это в примере лишь обрамление, а в исходной таблице немного другая стилистика, там некоторые ячейки и цветами закрашены =)
Если так будет реально проще, я тогда скину пример с другим оформлением…

 
Юрий М

Прикрепил пример с нужным оформлением. Как и в тот раз, на листе 1 — исходные данные, на листе 2 — что должно получиться после выполнения макроса.

Изменено: flashertheone22.05.2017 00:45:51

 

JeyCi

Пользователь

Сообщений: 3357
Регистрация: 27.11.2013

#19

22.05.2017 08:47:29

Цитата
flashertheone написал: там некоторые ячейки и цветами закрашены =)

а цвет — это не оформление?  :)
попробуйте добавить к коду #16 от

Юрий М

— Autofill (можно прямо из Справки F1 со своими диапазонами)

Код
Sub Macro1()
Dim LastRow As Long, i As Long, Rng As Range
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set Rng = Range(Cells(LastRow + 1, 1), Cells(LastRow + 1, 6))
    For i = LastRow To 6 Step -1
        If Application.WorksheetFunction.CountBlank(Range(Cells(i, 1), Cells(i, 6))) > 0 Then
            Range(Cells(LastRow, 1), Cells(i + 1, 6)).Cut Cells(i, 1)
            cnt = cnt + 1
        End If
    Next
    
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set SourceRange = Range(Cells(LastRow, 1), Cells(LastRow, 6))
    Set fillRange = Range(Cells(LastRow, 1), Cells(LastRow + cnt, 6))
    SourceRange.AutoFill Destination:=fillRange, Type:=xlFillFormats
End Sub

Изменено: JeyCi22.05.2017 08:48:02

чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок — обратитесь к собеседнику на ВЫ — ответ на ваш вопрос получите — а остальное вас не касается (п.п.п. на форумах)

 
JeyCi

, спасибо, это работает, но я только сейчас заметил, что этот макрос не удаляет последнюю строку. Вот попробуйте в файле с примером удалить из последней заполненной строки (№10) значение из любой ячейки, а затем активировать макрос . Он не удалит эту строку =(

 

flashertheone

Пользователь

Сообщений: 104
Регистрация: 12.05.2016

#21

22.05.2017 13:00:37

Я макрорекордером сам немного допилил макрос от

Ігор Гончаренко

из поста №4. Совсем уж дилетантский макрос получился или норм?) Работает, в принципе, как надо…

Код
Sub DelRowsWithBlankCell()
' Поиск и удаление пустых и частично заполненных строк, а также скрытие всех строк, начиная с 506-й
  Dim rg As Range:  On Error Resume Next
  With Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow
    If Err = 0 Then .ClearContents: .Copy Cells(506, 1): .Delete
  End With
  Rows("506:506").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Hidden = True
    Range("A6").Select
End Sub
 

JayBhagavan

Пользователь

Сообщений: 11833
Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

SELECT И ACTIVATE — ЗАЧЕМ НУЖНЫ И НУЖНЫ ЛИ?

<#0>
Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

 

flashertheone

Пользователь

Сообщений: 104
Регистрация: 12.05.2016

#23

22.05.2017 14:42:12

JayBhagavan, прочитал, буду стараться внедрять)

В общем, оказалось, что макрос от Ігор Гончаренко работает не совсем верно. При применении его в исходном файле получилась следующая ситуация:
Исходный файл состоит не только из одного этого листа, а из нескольких. Данные вводятся на лист2 в диапазон A6:F505, как я показал в примере. А на остальных листах в ячейках возвращаются данные, в зависимости от определенного условия через функции ИНДЕКС и ПОИСКПОЗ. То есть, на остальных листах стоят ссылки на этот диапазон. И при применении макроса от Ігор Гончаренко, ссылки портятся и приобретают вид не $A$6:$F$505, а #ССЫЛКА, соответственно остальные листы теряют свою функциональность…
При применении макроса от Юрий М такой проблемы нет, но этот макрос не работает на последнюю заполненную строку диапазона. То есть, например, мы скопировали данные на первые 6 строк, из любой ячейки 6-ой строки мы удаляем значение, применяем макрос и он эту строку оставляет (а должен очищать). Поэтому попрошу добрых людей допилить вот этот макрос таким образом, чтобы он работал и на последнюю строку тоже.

Код
Sub Macro1()
Dim LastRow As Long, i As Long, Rng As Range
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set Rng = Range(Cells(LastRow + 1, 1), Cells(LastRow + 1, 6))
    For i = LastRow To 6 Step -1
        If Application.WorksheetFunction.CountBlank(Range(Cells(i, 1), Cells(i, 6))) > 0 Then
            Range(Cells(LastRow, 1), Cells(i + 1, 6)).Cut Cells(i, 1)
            cnt = cnt + 1
        End If
    Next
     
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set SourceRange = Range(Cells(LastRow, 1), Cells(LastRow, 6))
    Set fillRange = Range(Cells(LastRow, 1), Cells(LastRow + cnt, 6))
    SourceRange.AutoFill Destination:=fillRange, Type:=xlFillFormats
End Sub

P.S. надо было в примере какие-нибудь связи между листами изобразить, а то подумал, что это не так уж важно, а оказалось в итоге, что сам запутался и других запутал)

 

flashertheone

Пользователь

Сообщений: 104
Регистрация: 12.05.2016

#24

22.05.2017 19:42:17

Или этот попробовать макрос доработать…

Код
Sub DelRowsWithBlankCell()
  Dim rg As Range:  On Error Resume Next
  With Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow
    If Err = 0 Then .ClearContents: .Copy Cells(506, 1): .Delete
  End With
End Sub

.Delete тут не подходит. Можно, например оставить этот кусок кода

Код
Sub DelRowsWithBlankCell()
  Dim rg As Range:  On Error Resume Next
  With Range("A6:F505").SpecialCells(xlCellTypeBlanks).EntireRow
    If Err = 0 Then .ClearContents
  End With
End Sub

Этот макрос будет очищать строки, если хотя бы одна из ячеек строки в указанном диапазоне пустая. Это то, что надо. Но как сделать так, чтобы пустых строк НЕ БЫЛО между заполненными строками? Без .Delete. Приложу скриншоты для «понятности», а то слов много, а на примере очень легко осознать, какого именно результата нужно добиться)
Ребят, выручайте, третий день не могу результата добиться…

Прикрепленные файлы

  • 2.png (5.71 КБ)
  • 1.png (6.15 КБ)

Изменено: flashertheone22.05.2017 19:44:06

5 / 5 / 0

Регистрация: 02.01.2017

Сообщений: 164

1

Нужен макрос для удаления значений в ячейках по условию

02.03.2017, 22:57. Показов 26112. Ответов 9


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

Ребята каким можно макросом удалять значения определённых ячеек .Задача макроса ,в ячейках в каждой из строк начиная с 28 строки столбца I ,промониторить выполняется ли условия чтобы если в ячейке значение меньше 2,00 то в этой строке будут стерты значения в ячейках C28 D28 E28 M28 N28 O28 P28 и так по всем ниже расположенным строкам без ограничения.Если условие в строке выполняется то значения в ячейках столбцов C,D,E,M,N,O,P это же строки будут удалены.Значения во всех этих ячейках введены используя выпадающий список.



0



smeckoi77

61 / 60 / 16

Регистрация: 13.02.2017

Сообщений: 172

03.03.2017, 00:47

2

Лучший ответ Сообщение было отмечено Aleks 1978 как решение

Решение

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub макрос()
 
For i = 28 To Range("A" & Rows.Count).End(xlUp).Row
    If Range("A" & i) < 2 Then
    Range("C" & i).ClearContents
    Range("D" & i).ClearContents
    Range("E" & i).ClearContents
    Range("M" & i).ClearContents
    Range("N" & i).ClearContents
    Range("O" & i).ClearContents
    Range("P" & i).ClearContents
    End If
Next i
 
End Sub



1



5 / 5 / 0

Регистрация: 02.01.2017

Сообщений: 164

03.03.2017, 03:03

 [ТС]

3

А можно пожалуйста ещё одно условие добавить в этот макрос ,к тому что в «A» ячейка < 2 .и ещё если в столбце «H» этой же строки ячейка имеет значение текст «ДА» то ‘макрос срабатывает на удаление значений в ячейках столбцов C,D,E,M,N,O,P.



0



k61

85 / 82 / 31

Регистрация: 13.10.2014

Сообщений: 167

03.03.2017, 05:46

4

Лучший ответ Сообщение было отмечено Aleks 1978 как решение

Решение

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Sub макрос_1()
For Each x In Range(Cells(28, 9), Cells(Cells(Rows.Count, 9).End(xlUp).Row, 9))
Set rrr = Union(Range(x.Offset(, -6), x.Offset(, -4)), Range(x.Offset(, 4), x.Offset(, 7)))
  If x < 2 Then
    If x.Offset(, -8) < 2 Then
      If x.Offset(, 11) = "ДА" Then rrr.ClearContents
    End If
  End If
Set rrr = Nothing
Next x
End Sub



1



Aleks 1978

5 / 5 / 0

Регистрация: 02.01.2017

Сообщений: 164

03.03.2017, 06:20

 [ТС]

5

А как можно вот этот вариант кода с одним условием,закрепив его выполнение за кнопкой на Листе 9 ,чтобы он смог сделать свои вычисления с данными находящимися на Листе3 ?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub макрос()
 
For i = 28 To Range("A" & Rows.Count).End(xlUp).Row
    If Range("A" & i) < 2 Then
    Range("C" & i).ClearContents
    Range("D" & i).ClearContents
    Range("E" & i).ClearContents
    Range("M" & i).ClearContents
    Range("N" & i).ClearContents
    Range("O" & i).ClearContents
    Range("P" & i).ClearContents
    End If
Next i
 
End Sub



0



smeckoi77

61 / 60 / 16

Регистрация: 13.02.2017

Сообщений: 172

03.03.2017, 08:22

6

Лучший ответ Сообщение было отмечено Aleks 1978 как решение

Решение

Перед словом Range везде дописать Sheets(«Лист3»).

Visual Basic
1
Sheets("Лист3").Range("A" & i)

Добавлено через 3 минуты
добавить условие в строку

Visual Basic
1
If Range("A" & i) < 2 And Range("H" & i) = "ДА" Then



1



Vlad999

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,930

03.03.2017, 09:35

7

Лучший ответ Сообщение было отмечено Aleks 1978 как решение

Решение

Visual Basic
1
2
3
4
5
Range("C" & i).ClearContents
Range("D" & i).ClearContents
Range("E" & i).ClearContents
вариант в одну строчку
Range("C" & i).Resize(1,3).ClearContents



1



Aleks 1978

5 / 5 / 0

Регистрация: 02.01.2017

Сообщений: 164

05.03.2017, 20:36

 [ТС]

8

Добавил в макрос второе условие,которые будут в столбце A отбирать на удаление только значения меньше 1,50 и больше 1,70.Вопрос в чём ошибка строки в коде? а то макрос не работает.

Visual Basic
1
  If Range("A" & i) <  1,50  And Range("A" & i)  >  1,70 Then
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Макрос ()
 
For i = 28 To Range("A" & Rows.Count).End(xlUp).Row
    If Range("A" & i) <  1,50  And Range("A" & i)  >  1,70 Then
    Range("C" & i).ClearContents
    Range("D" & i).ClearContents
    Range("E" & i).ClearContents
    Range("M" & i).ClearContents
    Range("N" & i).ClearContents
    Range("O" & i).ClearContents
    Range("P" & i).ClearContents
    End If
Next i
 End Sub



0



smeckoi77

61 / 60 / 16

Регистрация: 13.02.2017

Сообщений: 172

05.03.2017, 20:45

9

Число не может быть меньше 1,5 и больше 1,7 одновременно.

Добавлено через 4 минуты
значения меньше 1,50 ИЛИ больше 1,70

Добавлено через 40 секунд

Visual Basic
1
If Range("A" & i) <  1,50  Or Range("A" & i)  >  1,70 Then



1



5 / 5 / 0

Регистрация: 02.01.2017

Сообщений: 164

05.03.2017, 21:28

 [ТС]

10

Благодарю за помощь!Работает теперь



0



Уважаемые пользователи! Помогите, пожалуйста, создать два макроса, один из которых удалял бы значение из последней заполненной ячейки столбца, другой — из диапазона ячеек, границы которого буду указывать я. Большое спасибо!


Пожалуйста, не игнорируйте мою просьбу!


Цитата: lovko от 28.03.2013, 15:20
Пожалуйста, не игнорируйте мою просьбу!

lovko, без паники! Еще никто не успел посмотреть Ваш файл, а Вы уже пожар устраиваете. Люди на работе, надо понимать.

Sub www(): [Ввод_инф!a65536].End(xlUp).ClearContents: End Sub
Sub www1(): Sheets("Лист3").Range([Старотовая!E14]).ClearContents: End Sub

Я, как всегда, чертовски адекватен… Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771


Большое спасибо! Макросы работают. Вы мне очень помогли!


Метод Range.Clear для полной очистки диапазона ячеек из кода VBA Excel. Методы очистки отдельных свойств и их групп в ячейках. Примеры использования.

Методы очистки ячеек

Метод Очищаемые свойства Примечание
Range.Clear Почти все свойства Ширина и высота ячеек не изменяются
Range.ClearComments Комментарии Для Excel в составе Office 365
Range.ClearContents Формулы и значения Исходное форматирование сохраняется
Range.ClearFormats Свойства, задающие форматы В том числе отмена объединения ячеек
Range.ClearHyperlinks Гиперссылки Текст и форматирование сохраняются
Range.ClearNotes Примечания и заметки Примечания – для локальных программ Excel, заметки – для Excel в составе Office 365
Range.ClearOutline Структура данных Смотрите, что такое структурирование данных

Range – выражение, возвращающее диапазон ячеек.

Примеры использования

1. Удаление гиперссылки из ячейки A1
Cells(1, 1).ClearHyperlinks

2. Очистка диапазона A1:L50 от формул и значений
Range("A1:L50").ClearContents

3. Очистка всех свойств ячеек в столбцах A:K
Columns("A:K").Clear

4. Очистка форматирования ячеек в строках 1:20
Rows("1:20").ClearFormats

Методы очистки диапазонов ячеек в VBA Excel возвращают очищаемые свойства ячеек к значениям по умолчанию. К таким, как на вновь созданном стандартном рабочем листе. При любых методах очистки высота строк и ширина столбцов не изменяются.


Фразы для контекстного поиска: очистка ячеек, очистка ячейки, очистка формул, очистка от формул, удаление формул, очистка значений, удаление значений, очистка форматов, удаление форматирования, удаление форматов.


Макрос удаления значений из диапазона по вводу списка

svetonosniy

Дата: Четверг, 21.12.2017, 08:22 |
Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 12


Репутация:

0

±

Замечаний:
0% ±


Excel 2003

Доброго времени суток! Не могу найти нужную информацию, честно облазил весь форум. Требуется решить следующую задачу: имеется файл со множеством значений в одном столбце. Нужен макрос, который будет из выделенного диапазона удалять значения, которые введены или где либо заданы (ввод удаляемых значений может быть любым). На примере: в файле столбец B имеет множество значений, для простоты введем следующие:
значение 1
значение 2
значение 3
значение 2_1
значение 3_2
значение 1_3
значение 2_2
значение 3_1

В один прекрасный день появилась необходимость среди них из диапазона со строки 2 по строку 8 найти удалить следующие:
значение 3
значение 1_3

Нужен именно макрос, так как значений около 20000, требуется удалять штук по 50 из диапазонов, содержащих 100-1000 значений

Очень надеюсь на вашу помощь! В примере файла думаю смысла нет, но прикреплю на всякий случай то, что описал вsit

 

Ответить

китин

Дата: Четверг, 21.12.2017, 09:05 |
Сообщение № 2

Группа: Модераторы

Ранг: Экселист

Сообщений: 6973


Репутация:

1063

±

Замечаний:
0% ±


Excel 2007;2010;2016

как то так, наверное. то что удалять в желтой ячейке(выпадающий список) . и нажать кнопочку
[vba]

Код

Sub TTT()
Dim Lr&, i&
Lr = Cells(Rows.Count, 3).End(xlUp).Row
    For i = Lr To 2 Step -1
        If Cells(i, 3).Value = Cells(1, 6).Value Then
            Range(«C» & i).Delete Shift:=xlUp
        End If
     Next
End Sub

[/vba]


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Сообщение отредактировал китинЧетверг, 21.12.2017, 09:05

 

Ответить

svetonosniy

Дата: Четверг, 21.12.2017, 09:35 |
Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 12


Репутация:

0

±

Замечаний:
0% ±


Excel 2003

китин, спасибо, похоже, но не совсем, я наверное немного не так выразился. Удалять надо не поштучно, а списком, массивом. Указывать массив — и чтобы удалялись перечисленные значения при совпадении с диапазоном имеющихся значений

 

Ответить

sboy

Дата: Четверг, 21.12.2017, 10:39 |
Сообщение № 4

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566


Репутация:

724

±

Замечаний:
0% ±


Excel 2010

Подправил макрос Игоря.
Выделяем список для удаления и жмем кнопку
[vba]

Код

Sub TTT()
Dim arr_() ‘ переменная массив значений для удаления
Application.ScreenUpdating = False
Set r = Selection
    If Not r Is Nothing Then
        If r.Count = 1 Then ‘если выделена 1 ячейка
            ReDim arr_(1 To 1, 1 To 1) ‘ объявляем двумерный массив 1 на 1 для работы цикла ниже
            arr_(1, 1) = r.Value ‘ записываем единственное значение
        Else: arr_ = r.Value  ‘ если выделено больше 1 ячейки, то записываем значения в массив
        End If
        For x = 1 To UBound(arr_) ‘цикл по элементам массива
            For i = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1 ‘цикл по строкам где надо удалять
                If Cells(i, 3).Value = arr_(x, 1) Then Range(«C» & i).Delete Shift:=xlUp ‘если значение из массива совпадает с ячейкой — удаляем
            Next i
        Next x
    End If
Application.ScreenUpdating = True
End Sub

[/vba]

К сообщению приложен файл:

4106102.xlsm
(21.2 Kb)


Яндекс: 410016850021169

Сообщение отредактировал sboyЧетверг, 21.12.2017, 11:27

 

Ответить

svetonosniy

Дата: Четверг, 21.12.2017, 10:44 |
Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 12


Репутация:

0

±

Замечаний:
0% ±


Excel 2003

sboy, кажется то что надо! Спасибо, буду тестировать!

 

Ответить

китин

Дата: Четверг, 21.12.2017, 11:10 |
Сообщение № 6

Группа: Модераторы

Ранг: Экселист

Сообщений: 6973


Репутация:

1063

±

Замечаний:
0% ±


Excel 2007;2010;2016

Сергей а прокомментировать код можно?
pray pray pray


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

 

Ответить

sboy

Дата: Четверг, 21.12.2017, 11:28 |
Сообщение № 7

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566


Репутация:

724

±

Замечаний:
0% ±


Excel 2010

Игорь, написал в коде из сообщения выше


Яндекс: 410016850021169

 

Ответить

nilem

Дата: Четверг, 21.12.2017, 12:48 |
Сообщение № 8

Группа: Авторы

Ранг: Старожил

Сообщений: 1612


Репутация:

563

±

Замечаний:
0% ±


Excel 2013, 2016

Вариант:
[vba]

Код

Sub ttt()
Dim arr
With Range(«F1», Cells(Rows.Count, 6).End(xlUp))
    arr = Application.Transpose(.Value)
End With
With Range(«C1», Cells(Rows.Count, 3).End(xlUp))
    .AutoFilter 1, arr, 7
    .Offset(1).Delete Shift:=xlUp
    .AutoFilter
End With
End Sub

[/vba]


Яндекс.Деньги 4100159601573

 

Ответить

I am trying to create an Excel VBA that would delete only a specific part of the cell in only one column.

In Column A, I have a directory values:

For example:

Directoryof K:dataAdmin

What I would like to do is remove the «Directoryof» from all the cells in column A and leave only the remaining text that follows it.

Community's user avatar

asked Jul 28, 2015 at 16:44

Cory Gegg's user avatar

To create a macro to perform the above follow the below steps:

  1. Click the «Developer» tab on the top menu.
  2. You will find an option «Record Macro».
  3. Click the Record Macro ->
    a. A dialog box appears, give your macro a name
    b. Shortcut key (if you want) can give by pressing (shift and any key such as
    letters)
    c. Store macro in : This workbook (this allows your macro to run on this sheet).

  4. Click on «Use Relative References».

  5. Once you are done, just perform the delete operation ( by removing the portion you do not want) on one of the column so that the macro may record the process which you are performing.

  6. Once done, below at the lowest pane you will find Stop Macro option (a small blue square box). Click it to stop the recording of the macro.

  7. Now you are ready with a macro to replicate the same without you performing the operation.

  8. Just goto any other column where you want to perform the operation and click on «Macro» option on the developer tab and then click on your created marco, and you will see the magic happen.

answered Jul 28, 2015 at 17:24

Sudhanshu Agrawal's user avatar

You could probably use regex to accomplish what you are going for. Regular Expressions are often used for finding patterns. If all of your follows the same format, you could break your strings apart into two capture groups with something like:

(.+)([A-Z]:\.+)

https://regex101.com/r/uD4uJ0/2 <— this will show you your capture groups

Edit: I updated this link, sorry, originally had the wrong one.

This here How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops will show you how to split up capture groups if you are interested.

Community's user avatar

answered Jul 28, 2015 at 17:02

Scott T's user avatar

Scott TScott T

2332 gold badges5 silver badges14 bronze badges

You could use something like text to columns, fixed width, and split the columns after Directoryof and then copy/paste the values back into column A.

I’m not sure if there’s a method to do this without a helper column without VBA. If you can afford to use a second column, you can also use =LEFT(Cell, # of characters) assuming that the part you want to strip off is always «Directoryof» and then copy/paste values back into column A.

shA.t's user avatar

shA.t

16.4k5 gold badges53 silver badges111 bronze badges

answered Jul 28, 2015 at 16:58

KFichter's user avatar

KFichterKFichter

7534 silver badges15 bronze badges

макрос удалит на листе все строки, в которых содержится искомый текст:

(пример — во вложении ConditionalRowsDeleting.xls)

Sub УдалениеСтрокПоУсловию()
    Dim ra As Range, delra As Range, ТекстДляПоиска As String
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ТекстДляПоиска = "Наименование ценности"    ' удаляем строки с таким текстом

    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
End Sub

Чтобы вместо удаления просто скрыть такие строки, замените строку

If Not delra Is Nothing Then delra.EntireRow.Delete

на

If Not delra Is Nothing Then delra.EntireRow.Hidden=TRUE

Расширенная версия этого макроса — с использованием UserForm для ввода искомого значения

Function ПоискСтрокПоУсловию(ByVal ТекстДляПоиска As String, Optional HideOnly As Boolean) As Long
    ' функция получает в качестве параметра ТекстДляПоиска (можно использовать символы * и ?)
    ' Если HideOnly = TRUE, то строки, содержащие в ячейках ТекстДляПоиска, скрываются,
    ' иначе (HideOnly = FALSE - по умолчанию) - удаляются
    ' Функция возвращает количество удалённых строк
    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    On Error Resume Next: ПоискСтрокПоУсловию = delra.Areas.Count ' количество найденных строк
    
    If Not delra Is Nothing Then    ' если подходящие строки найдены - скрываем или удаляем их
        If HideOnly Then delra.EntireRow.Hidden = True Else delra.EntireRow.Delete
    End If
End Function

Ещё один вариант кода, позволяющего выполнять поиск (с последующим удалением или скрытием строк) сразу по нескольким условиям:

Sub УдалениеСтрокПоНесколькимУсловиям()
    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' ищем и удаляем строки, содержащие заданный текст
    ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
    УдалятьСтрокиСТекстом = Array("Наименование *", "Количество", _
                                  "текст?", "цен*сти", "*78*")
 
    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' перебираем все фразы в массиве
        For Each word In УдалятьСтрокиСТекстом
            ' если в очередной строке листа найден искомый текст
            If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then
                ' добавляем строку в диапазон для удаления
                If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
            End If
        Next word
    Next
 
    ' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк)
    If Not delra Is Nothing Then delra.EntireRow.Hidden = True    ' скрываем их
    If Not delra Is Nothing Then delra.EntireRow.Delete    ' удаляем их
End Sub

Понравилась статья? Поделить с друзьями:
  • Максимальная ширина таблицы excel
  • Макросы углов в excel
  • Максимальная ширина строки в excel
  • Макросы сумма прописью для excel
  • Максимальная ширина столбца excel