Доброго дня ! Пришлось тут безуспешно обрабатывать большой объем статистических данных из Рунета, часть которых не нужна для дальнейшей работы. То есть текстовый файл с числами и словами вставляю в Ехель, получаю длинный столбец данных. Задачка вроде простейшая, но ума не хватает. Помогите.
Задача 1ая - Сделать какой макрос, который будет убирать ненужные данные. Выделяю этот столбец. Запускаю макрос, который находит слово (не нужное для дальнейшей работы, например "Автомобиль") в ячейке, содержимое ячейки обнуляется, в смысле делается пустой, и далее все ячейки, которые ниже этой пустой ячейки, сдвигаются на одну ячейку вверх. Что-то типа -
[vba]
Код
Sub vvv() Dim r As Range For Each r In Selection If r.Value = "Автомобиль" Then r.Interior.Color = vbRed ElseIf Len(r) = 1 Then r.Value = "'0" & r.Value End If Next End Sub
[/vba]
где строки r.Interior.Color = vbRed ElseIf Len® = 1 Then r.Value = "'0" & r.Value надо поменять на операцию сдвинуть нижележащие ячейки вверх на одну ячейку.
Доброго дня ! Пришлось тут безуспешно обрабатывать большой объем статистических данных из Рунета, часть которых не нужна для дальнейшей работы. То есть текстовый файл с числами и словами вставляю в Ехель, получаю длинный столбец данных. Задачка вроде простейшая, но ума не хватает. Помогите.
Задача 1ая - Сделать какой макрос, который будет убирать ненужные данные. Выделяю этот столбец. Запускаю макрос, который находит слово (не нужное для дальнейшей работы, например "Автомобиль") в ячейке, содержимое ячейки обнуляется, в смысле делается пустой, и далее все ячейки, которые ниже этой пустой ячейки, сдвигаются на одну ячейку вверх. Что-то типа -
[vba]
Код
Sub vvv() Dim r As Range For Each r In Selection If r.Value = "Автомобиль" Then r.Interior.Color = vbRed ElseIf Len(r) = 1 Then r.Value = "'0" & r.Value End If Next End Sub
[/vba]
где строки r.Interior.Color = vbRed ElseIf Len® = 1 Then r.Value = "'0" & r.Value надо поменять на операцию сдвинуть нижележащие ячейки вверх на одну ячейку.Valeriy22
Сообщение отредактировал Valeriy22 - Четверг, 25.01.2018, 19:32
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]
Работает !! Спасибо
Mikael,
[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() With Selection .Replace "Автомобиль", "=xx1", xlWhole Intersect([xx1].Dependents, .Cells).Delete xlUp With .SpecialCells(xlCellTypeConstants, 1) Set r = .Find("?", , xlValues, xlWhole, Searchformat:=False) Do While Not r Is Nothing r.Formula = Format(r, "'00") Set r = .FindNext(r) Loop End With End With End Sub
[/vba]
до кучи [vba]
Код
Sub vvv() With Selection .Replace "Автомобиль", "=xx1", xlWhole Intersect([xx1].Dependents, .Cells).Delete xlUp With .SpecialCells(xlCellTypeConstants, 1) Set r = .Find("?", , xlValues, xlWhole, Searchformat:=False) Do While Not r Is Nothing r.Formula = Format(r, "'00") Set r = .FindNext(r) Loop End With End With End Sub