Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Удаление лишних значений с ячейки - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление лишних значений с ячейки (Макросы/Sub)
Удаление лишних значений с ячейки
reventon9 Дата: Четверг, 11.08.2016, 07:36 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 40% ±

Excel 2013
Здравствуйте!

Помогите, пожалуйста, удалить(с помощью макроса) лишние значения(цифры) из ячейки.

Данные для удаления выделены красным.

Заранее спасибо...
К сообщению приложен файл: 7873162.xlsx(11Kb)
 
Ответить
СообщениеЗдравствуйте!

Помогите, пожалуйста, удалить(с помощью макроса) лишние значения(цифры) из ячейки.

Данные для удаления выделены красным.

Заранее спасибо...

Автор - reventon9
Дата добавления - 11.08.2016 в 07:36
KuklP Дата: Четверг, 11.08.2016, 08:40 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2020
Репутация: 439 ±
Замечаний: 20% ±

[vba]
Код
Public Sub www(): [f:f].Replace Chr(10) & "*", "", xlPart: End Sub
[/vba]


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение[vba]
Код
Public Sub www(): [f:f].Replace Chr(10) & "*", "", xlPart: End Sub
[/vba]

Автор - KuklP
Дата добавления - 11.08.2016 в 08:40
reventon9 Дата: Четверг, 11.08.2016, 09:04 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 40% ±

Excel 2013
Спасибо!
 
Ответить
СообщениеСпасибо!

Автор - reventon9
Дата добавления - 11.08.2016 в 09:04
reventon9 Дата: Пятница, 12.08.2016, 08:36 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 40% ±

Excel 2013
Подскажите, пожалуйста, еще аналогичные макросы.... в этом же файле
Файл приложил, описание внутри, что нужно удалить выделил...

Заранее спасибо
К сообщению приложен файл: 6494818.xlsx(12Kb)
 
Ответить
СообщениеПодскажите, пожалуйста, еще аналогичные макросы.... в этом же файле
Файл приложил, описание внутри, что нужно удалить выделил...

Заранее спасибо

Автор - reventon9
Дата добавления - 12.08.2016 в 08:36
Karataev Дата: Воскресенье, 14.08.2016, 10:16 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 726
Репутация: 260 ±
Замечаний: 0% ±

Excel
Макрос удаляет:
1) в столбце "D" текст, который начинается с новой строки и строка начинается скобкой "("
2) в столбце "D" текст, который начинается с новой строки и строка начинается русскими символами "НР"
3) в столбце "F" весь текст, который начинается с новой строки

Что касается удаления после единиц измерения, то здесь нельзя предсказать, в каком виде будет единица измерения, поэтому нельзя, не видя всех возможных случаев, сделать код. Если опираться на файл пример из поста 4, то можно сделать макрос, который будет удалять весь текст после 2-го пробела. Но если ед измерения будет включать два пробела, то будет удалено нужное.

[vba]
Код
Sub Макрос()
    Columns("D").Replace What:=Chr(10) & "(*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("D").Replace What:=Chr(10) & "НР*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("F").Replace What:=Chr(10) & "*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub
[/vba]




Сообщение отредактировал Karataev - Воскресенье, 14.08.2016, 13:34
 
Ответить
СообщениеМакрос удаляет:
1) в столбце "D" текст, который начинается с новой строки и строка начинается скобкой "("
2) в столбце "D" текст, который начинается с новой строки и строка начинается русскими символами "НР"
3) в столбце "F" весь текст, который начинается с новой строки

Что касается удаления после единиц измерения, то здесь нельзя предсказать, в каком виде будет единица измерения, поэтому нельзя, не видя всех возможных случаев, сделать код. Если опираться на файл пример из поста 4, то можно сделать макрос, который будет удалять весь текст после 2-го пробела. Но если ед измерения будет включать два пробела, то будет удалено нужное.

[vba]
Код
Sub Макрос()
    Columns("D").Replace What:=Chr(10) & "(*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("D").Replace What:=Chr(10) & "НР*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("F").Replace What:=Chr(10) & "*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub
[/vba]

Автор - Karataev
Дата добавления - 14.08.2016 в 10:16
reventon9 Дата: Воскресенье, 14.08.2016, 10:57 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 40% ±

Excel 2013
Спасибо!

По столбику Е, где единицы измерения, подскажите, пожалуйста, тогда макрос: удалять после 2-го пробела...
 
Ответить
СообщениеСпасибо!

По столбику Е, где единицы измерения, подскажите, пожалуйста, тогда макрос: удалять после 2-го пробела...

Автор - reventon9
Дата добавления - 14.08.2016 в 10:57
Karataev Дата: Воскресенье, 14.08.2016, 11:11 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 726
Репутация: 260 ±
Замечаний: 0% ±

Excel
[vba]
Код
Sub Макрос()

    Dim arr(), spl, lr As Long, i As Long

    Application.ScreenUpdating = False

    Columns("D").Replace What:=Chr(10) & "(*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("D").Replace What:=Chr(10) & "НР*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("F").Replace What:=Chr(10) & "*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    lr = Columns("E").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr() = Range("E4:E" & lr).Value
    For i = 1 To UBound(arr)
        spl = Split(arr(i, 1), " ")
        If UBound(spl) > 0 Then
            arr(i, 1) = spl(0) & " " & spl(1)
        End If
    Next
    Range("E4").Resize(UBound(arr)).Value = arr()
        
    Application.ScreenUpdating = True
    
End Sub
[/vba]


 
Ответить
Сообщение[vba]
Код
Sub Макрос()

    Dim arr(), spl, lr As Long, i As Long

    Application.ScreenUpdating = False

    Columns("D").Replace What:=Chr(10) & "(*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("D").Replace What:=Chr(10) & "НР*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("F").Replace What:=Chr(10) & "*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    lr = Columns("E").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr() = Range("E4:E" & lr).Value
    For i = 1 To UBound(arr)
        spl = Split(arr(i, 1), " ")
        If UBound(spl) > 0 Then
            arr(i, 1) = spl(0) & " " & spl(1)
        End If
    Next
    Range("E4").Resize(UBound(arr)).Value = arr()
        
    Application.ScreenUpdating = True
    
End Sub
[/vba]

Автор - Karataev
Дата добавления - 14.08.2016 в 11:11
reventon9 Дата: Воскресенье, 14.08.2016, 11:33 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 40% ±

Excel 2013
Спасибо!!!
 
Ответить
СообщениеСпасибо!!!

Автор - reventon9
Дата добавления - 14.08.2016 в 11:33
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление лишних значений с ячейки (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!