Удаление ячеек с заданным словом часть 2

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Удаление ячеек с заданным словом часть 2 (Макросы/Sub)

Valeriy22

Дата: Пятница, 26.01.2018, 16:12 | Сообщение № 1

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

Ранг: Прохожий

Сообщений: 7

Репутация: 0 ±

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

Excel 2016

В продолжение http://www.excelworld.ru/forum/10-37017-1

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

При обработке массива данных у меня возникли вопросы -

1. Возможен ли за один проход макроса найти и опустошить ячейки с РАЗНЫМИ словам ?
Мне не нужны слова "автомобиль" и "метла".

[vba]

Код

Sub vvv()
Dim r As Range
For Each r In Selection
If r.Value = "Автомобиль" Then
r.Delete Shift:=xlUp
ElseIf Len(r) = 1 Then r.Value = "'0" & r.Value 'на эту строку не обращайте внимания, пусть будет.
End If
Next
End Sub

[/vba]

Можно ли както вставить в код еще одно (два-три) "ненужных" слова для поиска и опустошения (ту же "метлу") ?

2. Можно ли искать слово (словА) по нескольким начальным знакам этиХ слов ?
Например - у меня есть слова "автомобиль" (повтор в массиве более 50 раз), слово "автомойка" (повтор более 20 раз),
и слово "авторота" (повтор более 10 раз).
Можно ли включить в код префикс для них "авто" (или "авт", или "ав") для поиска и опустошения этих ячеек ?

[vba]

Код

Sub vvv()
Dim r As Range
For Each r In Selection
If r.Value = "Автомобиль" Then
r.Delete Shift:=xlUp
ElseIf Len(r) = 1 Then r.Value = "'0" & r.Value
End If
Next
End Sub

[/vba]

И сюда же - также имею ненужные слова, типа 6112, 6115, 6124, ...6198. Ячеек с подобными слова почти 100 штук.
Повторяются они только один раз.
Можно ли както вставить в код префикс "61" для опустошения ячеек с этими словами (6112, 6115, 6124, ...6198) ?

3. Пр копировании инфы из WWW в Ехель - в Ехель попал знак, который копипастом я не могу запостить сюда,
а также не могу вставить в редактор VBA, и даже в Блокнот. Смотри пикчу во вложении - там этот знак.
Возможно это знак ASC, который вводится через Alt+(три цифры с правой стороны клавиатуры).
Как такой знак прописать на обнаружение и опустошение ? А знака этого у меня много.

[vba]

Код

Sub vvv()
Dim r As Range
For Each r In Selection
If r.Value = "Автомобиль" Then
r.Delete Shift:=xlUp
ElseIf Len(r) = 1 Then r.Value = "'0" & r.Value
End If
Next
End Sub

[/vba]

Код

Sub vvv()
Dim r As Range
For Each r In Selection
If r.Value = "Автомобиль" Then
r.Delete Shift:=xlUp
ElseIf Len(r) = 1 Then r.Value = "'0" & r.Value
End If
Next
End Sub

Код

Sub vvv()
Dim r As Range
For Each r In Selection
If r.Value = "Автомобиль" Then
r.Delete Shift:=xlUp
ElseIf Len(r) = 1 Then r.Value = "'0" & r.Value
End If
Next
End Sub

[/vba]Valeriy22

К сообщению приложен файл: 1233672.jpg (47.8 Kb)

Сообщение отредактировал Valeriy22 - Пятница, 26.01.2018, 16:23

Ответить

СообщениеВ продолжение http://www.excelworld.ru/forum/10-37017-1

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

При обработке массива данных у меня возникли вопросы -

1. Возможен ли за один проход макроса найти и опустошить ячейки с РАЗНЫМИ словам ?
Мне не нужны слова "автомобиль" и "метла".

[vba]

Код

Sub vvv()
Dim r As Range
For Each r In Selection
If r.Value = "Автомобиль" Then
r.Delete Shift:=xlUp
ElseIf Len(r) = 1 Then r.Value = "'0" & r.Value
End If
Next
End Sub

Код

Sub vvv()
Dim r As Range
For Each r In Selection
If r.Value = "Автомобиль" Then
r.Delete Shift:=xlUp
ElseIf Len(r) = 1 Then r.Value = "'0" & r.Value
End If
Next
End Sub

[/vba]

Автор - Valeriy22
Дата добавления - 26.01.2018 в 16:12

sboy

Дата: Пятница, 26.01.2018, 16:23 | Сообщение № 2

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

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

Сообщений: 2566

Репутация: 724 ±

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

Excel 2010

Добрый день.
зачем вставлять один и тот же код 3 раза?
по первым 2 пунктам можно воспользоваться оператором Like
[vba]

Код

If r.Value = Like "Авто*" Or r.Value = Like "Метла" Or r.Value = Like "61*" Then

[/vba]

Яндекс: 410016850021169

Сообщение отредактировал sboy - Пятница, 26.01.2018, 16:23

Ответить

krosav4ig

Дата: Пятница, 26.01.2018, 16:51 | Сообщение № 3

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

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

Сообщений: 2348

Репутация: 997 ±

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

Excel 2007,2010,2013

[vba]

Код

Sub vvv()
    Dim v As Variant
    On Error Resume Next
    With Selection
        For Each v In Array("авто*", "Метла", "61??", ChrW(157))
            .Replace v, "=xfd1", xlWhole, searchformat:=False
            Intersect([xfd1].Dependents, .Cells).Delete xlUp
        Next
    End With
End Sub

[/vba]

Цитата Valeriy22, 26.01.2018 в 16:12, в сообщении № 1 ()

Как такой знак прописать

для начала нужно выделить ячейку с этим символом, в VBE в окно Immediate(если его нету, нажать Ctrl+G для отобраения) ввести ?ascw(selection) и нажать Enter
Полученное число вставить в функцию ChwW() вместо 157

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Пятница, 26.01.2018, 16:52

Ответить

Mikael

Дата: Пятница, 26.01.2018, 17:01 | Сообщение № 4

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

Ранг: Участник

Сообщений: 80

Репутация: 31 ±

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

Excel 2010

Valeriy22, может быть легче указать условие что нужно оставить?
Повторюсь, файл-пример в excel поможет лучше понять Вашу задачу, и предложить оптимальный вариант.
Например, так останутся даты и числа:
[vba]

Код

If (Not IsNumeric(r) And Not IsDate(r)) Or IsEmpty(r) Then r.Delete Shift:=xlUp

[/vba]
Плюс ко всему, когда удаляете ячейки/строки/столбцы, итерацию всегда нужно начинать с конца, иначе можете получить не корректный результат.
[vba]

Код

Dim r As Range, i As Long
For i = Selection.Count To 1 Step -1
Set r = Selection(i)
If (Not IsNumeric(r) And Not IsDate(r)) Or IsEmpty(r) Then r.Delete Shift:=xlUp
Next i

[/vba]

Ответить

Удаление ячеек с заданным словом часть 2 (Макросы/Sub)

Страница 1 из 1
1