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

Вход

Регистрация

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

 

= Мир MS Excel/Убрать макросом не нужные цифры с условием - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Убрать макросом не нужные цифры с условием (Макросы/Sub)
Убрать макросом не нужные цифры с условием
grh1 Дата: Среда, 20.09.2017, 20:17 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
Доброго дня, уважаемые!

В файле-примере имеется список из цифр такого вида:
09110000-3
09111000-0
09110000-6
09111000-3

09121100-4
09121200-5
09122000-0
09122100-1
09122110-4
09122200-2

09130000-9
09131000-6
09131100-7
09132000-3
09132100-4
09132200-5
09132300-6


Макрос убирает ненужные мне цифры, и получается так:

0911
0911
0911
0911

0912
0912
0912
0912
0912

0913
0913
0913
0913
0913
0913
0913


а мне нужно, чтобы был такой вид:

0911
0912
0913

(цвет выделил просто для наглядности)

Прикрепляю файл.
Всего строк с цифрами 9455 (удалил лишние, чтобы вес файла был до 100кб)

Что нужно дописать в код, чтобы макрос удалял все повторяющиеся?
К сообщению приложен файл: 5749627.xls (98.5 Kb)


Vadym Gorokh

Сообщение отредактировал grh1 - Среда, 20.09.2017, 20:19
 
Ответить
СообщениеДоброго дня, уважаемые!

В файле-примере имеется список из цифр такого вида:
09110000-3
09111000-0
09110000-6
09111000-3

09121100-4
09121200-5
09122000-0
09122100-1
09122110-4
09122200-2

09130000-9
09131000-6
09131100-7
09132000-3
09132100-4
09132200-5
09132300-6


Макрос убирает ненужные мне цифры, и получается так:

0911
0911
0911
0911

0912
0912
0912
0912
0912

0913
0913
0913
0913
0913
0913
0913


а мне нужно, чтобы был такой вид:

0911
0912
0913

(цвет выделил просто для наглядности)

Прикрепляю файл.
Всего строк с цифрами 9455 (удалил лишние, чтобы вес файла был до 100кб)

Что нужно дописать в код, чтобы макрос удалял все повторяющиеся?

Автор - grh1
Дата добавления - 20.09.2017 в 20:17
buchlotnik Дата: Среда, 20.09.2017, 20:31 | Сообщение № 2
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
Здравствуйте, так нужно?
[vba]
Код
Sub test()
    Dim cell As Range
    For Each cell In Selection.Cells
        cell = Left(cell.Text, 4)
    Next cell
    Selection.RemoveDuplicates Columns:=1, Header:=2
End Sub
[/vba]
К сообщению приложен файл: 0832767.xls (82.0 Kb)
 
Ответить
СообщениеЗдравствуйте, так нужно?
[vba]
Код
Sub test()
    Dim cell As Range
    For Each cell In Selection.Cells
        cell = Left(cell.Text, 4)
    Next cell
    Selection.RemoveDuplicates Columns:=1, Header:=2
End Sub
[/vba]

Автор - buchlotnik
Дата добавления - 20.09.2017 в 20:31
grh1 Дата: Среда, 20.09.2017, 20:41 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
buchlotnik,
отлично, спасибо большое.
Скажите, а макрос со строкой
[vba]
Код
ActiveSheet.Range("$A$1:$A$1403").RemoveDuplicates Columns:=1, Header:=2
[/vba]
должен быть в отдельном модуле, или его можно дописать в основной макрос test()?


Vadym Gorokh
 
Ответить
Сообщениеbuchlotnik,
отлично, спасибо большое.
Скажите, а макрос со строкой
[vba]
Код
ActiveSheet.Range("$A$1:$A$1403").RemoveDuplicates Columns:=1, Header:=2
[/vba]
должен быть в отдельном модуле, или его можно дописать в основной макрос test()?

Автор - grh1
Дата добавления - 20.09.2017 в 20:41
buchlotnik Дата: Среда, 20.09.2017, 20:44 | Сообщение № 4
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
grh1, я просто второй модуль не удалил - снесите его и всё, вашу задачу решает [vba]
Код
Selection.RemoveDuplicates Columns:=1, Header:=2
[/vba] в основном макросе
 
Ответить
Сообщениеgrh1, я просто второй модуль не удалил - снесите его и всё, вашу задачу решает [vba]
Код
Selection.RemoveDuplicates Columns:=1, Header:=2
[/vba] в основном макросе

Автор - buchlotnik
Дата добавления - 20.09.2017 в 20:44
grh1 Дата: Среда, 20.09.2017, 21:04 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
buchlotnik,
на большом объеме не хочет работать - виснет excel.
Попробуйте пожалуйста у себя. Файл прикрепил
К сообщению приложен файл: 4325230.rar (73.7 Kb)


Vadym Gorokh
 
Ответить
Сообщениеbuchlotnik,
на большом объеме не хочет работать - виснет excel.
Попробуйте пожалуйста у себя. Файл прикрепил

Автор - grh1
Дата добавления - 20.09.2017 в 21:04
grh1 Дата: Среда, 20.09.2017, 21:41 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
buchlotnik,
спасибо еще раз
закрыли тему


Vadym Gorokh
 
Ответить
Сообщениеbuchlotnik,
спасибо еще раз
закрыли тему

Автор - grh1
Дата добавления - 20.09.2017 в 21:41
buchlotnik Дата: Среда, 20.09.2017, 21:43 | Сообщение № 7
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
попробовал - 0,03 сек
 
Ответить
Сообщениепопробовал - 0,03 сек

Автор - buchlotnik
Дата добавления - 20.09.2017 в 21:43
grh1 Дата: Среда, 20.09.2017, 21:51 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
buchlotnik,
не знаю - вроде и комп не слабый... наверно кривоват сам офис. Сделал частями. Спасибо


Vadym Gorokh
 
Ответить
Сообщениеbuchlotnik,
не знаю - вроде и комп не слабый... наверно кривоват сам офис. Сделал частями. Спасибо

Автор - grh1
Дата добавления - 20.09.2017 в 21:51
KuklP Дата: Четверг, 21.09.2017, 07:00 | Сообщение № 9
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Вариант:
[vba]
Код
Sub www()
    With ActiveSheet.UsedRange.Columns(1)
    .TextToColumns [A1], 2, FieldInfo:=Array(Array(0, 1), Array(4, 9))
    .AdvancedFilter xlFilterCopy, , [N1], True
    End With
End Sub
[/vba]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеВариант:
[vba]
Код
Sub www()
    With ActiveSheet.UsedRange.Columns(1)
    .TextToColumns [A1], 2, FieldInfo:=Array(Array(0, 1), Array(4, 9))
    .AdvancedFilter xlFilterCopy, , [N1], True
    End With
End Sub
[/vba]

Автор - KuklP
Дата добавления - 21.09.2017 в 07:00
grh1 Дата: Четверг, 21.09.2017, 19:20 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
KuklP,
спасибо.


Vadym Gorokh
 
Ответить
СообщениеKuklP,
спасибо.

Автор - grh1
Дата добавления - 21.09.2017 в 19:20
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Убрать макросом не нужные цифры с условием (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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