Страницы: 1 2 След.
RSS
Убрать из ячейки все кроме цифр
 
Добрый день!
Подскажите пожалуйста, кто знает, как можно макросом удалить из ячейки все символы, кроме цифр?
 
Отсюда
Код
Public Function onlyDigits(stroka) 'Только цифры
    Static objRegExp As Object
     If objRegExp Is Nothing Then
         Set objRegExp = CreateObject("VBScript.RegExp")
         objRegExp.Global = True
         objRegExp.Pattern = "[^0-9]"
     End If
     onlyDigits = objRegExp.Replace(stroka, "")
 End Function
Изменено: skais675 - 28.05.2019 09:43:38
 
Добрый день!

Почитайте здесь
 
Спасибо!
 
Нашел свою реализацию (немного подправил, версия от сегодняшнего числа). До двух раз быстрее на длинных строках и смешанном тексте (в сравнении с кодом, пост2). Выкладываю код и тест.
На данных: строка - 32 тыс. символов, строк - 10 тыс. - 10 сек, против 20 сек. через регулярки.
На меньших сроках превосходство меньше, но все равно существенное.
Прошу тестировать.
Код
Option Explicit
'Автор Б. Виталий В. (bvv, bedvit)
'Редакция: 1 от 29/05/2019
'Действие: Функция - в строке остаются только цифры

Public Function Digits(ByVal str As String) As String
Dim x As Long, y As Long, Chars() As Byte, Chars2() As Byte, Char As Byte
Chars = str: ReDim Preserve Chars2(UBound(Chars) + 1)
For x = LBound(Chars) To UBound(Chars) Step 2
    If Chars(x + 1) = 0 Then
    Char = Chars(x)
        If Char < 58 Then If Char > 47 Then Chars2(y) = Char: y = y + 2
    End If
Next
Digits = Chars2
End Function
Изменено: bedvit - 29.05.2019 13:09:29
«Бритва Оккама» или «Принцип Калашникова»?
 
bedvit, отличная функция, но для того, чтобы оставить кириллицу нужно что-то с ней сделать, т.к. преобразует в байты на 176 позиций назад и "разделяет" через 4, а не 0.

То есть: ВАСЯ это не 194/0/192/0/209/0/223/0, а 18/4/16/4/33/4/47/4
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
RegExp с маской "\D+" будет удалять символы не по одному, а группами, что существенно резвее
Код
Function DigitOnly(s$)
  Dim re
  Set re = CreateObject("VBScript.RegExp"): re.Global = True
  re.Pattern = "\D+":  DigitOnly = re.Replace(s, "")
End Function
Изменено: Ігор Гончаренко - 23.07.2019 16:08:35
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Jack Famous, мой код делает именно то, что нужно было по теме. Если отбирать только кириллицу, нужно изменить в макросе коды нужных знаков Юникода. Помним, про "Ё".
Ігор Гончаренко, да, так быстрее на порядок, тест:
onlyDigits 20,07031
Digits 10,64453
DigitOnly 2,636719
«Бритва Оккама» или «Принцип Калашникова»?
 
Доброе время суток.
Цитата
Ігор Гончаренко написал:
существенно резвее
Протестировал на строке из 40 387 200 символов. Длина строки результата 301 800 (цифры только).
Ігор Гончаренко, шаблон "\D+", время 0,18 секунды
skais675, шаблон "[^0-9]", время 1,77 секунды
skais675, шаблон "[^0-9]+", время 0,27 секунды
bedvit, 1,2 секунды
 
bedvit, я пока всё-равно остановился на регулярках, т.к. и быстрее и передавать аргумент (маску) проще и понятнее, НО серьёзно удивился способу формирования одномерного байтового массива напрямую arr() As Byte=txt$ и обратно (строки из массива) — очень круто  :idea:
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
удивился способу формирования одномерного байтового массива
Рекомендовано разработчиком.
Владимир
 
sokol92, спасибо  ;)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, спасибо, пользуйтесь.
sokol92, Владимир, спасибо за инфо.
Андрей VG, Андрей, спасибо за тест. Посмотрел, что на таких больших объемах мой код в аутсайдерах. Другое дело, что в ячейку столько не влезет, поэтому не так критично.
Тоже смотрю последнее время на регулярки. Есть идея зашить в функцию (C API), на это нужно время, зато для форума польза. Скорость думаю должна быть неплохая ;)
Вот, к примеру протестируй, пожалуйста функцию "DigitsXLL" в нужной разрядности XLL на своем массиве (через Application. Run, нужно просто открыть XLL, функция появится в категории "BedvitXLL")
У меня следующие результаты, на моем примере (см. вложение).
onlyDigits 20 сек
Digits 10 сек
DigitOnly 2,6 сек
DigitsXLL 0,4 сек
Изменено: bedvit - 23.07.2019 18:07:22
«Бритва Оккама» или «Принцип Калашникова»?
 
Цитата
bedvit написал:
что на таких больших объемах мой код в аутсайдерах
Привет, Виталий.
С твоим кодом в VBA есть и ещё проблема. Тестовый вывод показывает, что не удаляется ничего. Не пошёл и вызов Application.Run("DigitsXLL", sText), как и с Evaluate - видимо слишком длинная строка :) Результаты.
Цитата
Igor \D+ time: 0,0859375; digit count: 1299456; all count: 43895808
skais675 [^\d]+ time: 0,3828125; digit count: 1299456; all count: 43895808
BedVit VBA time: 1,117188; digit count: 43895808; all count: 43895808
Тестовый файл и код прикладываю. longText.zip в формате 7z (к сожалению форум не позволяет прикладывать архивы таком формате).
P. S. Решил сравнить с библиотекой .Net и тут засада. Или у меня руки не оттуда растут или... Результат
Цитата
Net time: 719,0871 мсек; digits count: 1299456; all count: 43895808
Скрытый текст
 
По  DigitsXLL понятно, это функция листа, в ячейку больше 32 тысяч не лезет. Сразу не сообразил.
По Digits в VBA - пока не понял, гляну.
На .NET тоже глянем, как можно ускорить.
Здесь появляется два момента:
1. Самая быстрая функция для расчетов в ячейке Excel, макс 32 767 знаков(VBA, COM, XLL)
2. Самая быстрая функция для любого количества знаков.
2.1 что бы можно использовать в VBA (VBA, COM)
2.2 любой инструмент (EXE на .NET, EXE на С++)

Что хотим потестировать?
Готов поучаствовать везде.
«Бритва Оккама» или «Принцип Калашникова»?
 
Цитата
bedvit написал:
любой инструмент (EXE на .NET, EXE на С++)
Виталий, я максимум на Net. Вечером слеплю в ExcelDNA многопоточную версию для функции рабочего листа, протестирую.
 
bedvit, да - я понял, что с цифрами всё ОК, но вот дальше всё-равно не догоняю…

В таблице (по вашей ссылке) Кириллица такая: 1025(Ё), 1040(А) - 1103(я), 1105(ё)
1. "ВАСЯ" по ней: 1042 | 1040 | 1057 | 1071
2. • при преобразовании в байтовый массив: 18 | 16 | 33 | 47 (через "4")
3. • при преобразовании сначала через StrConv: 18 | 16 | 33 | 47 (через "0-4-0" вместо "4")

Где тут логика и как поступать???
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, здесь по-моему неплохо про это написано.
Изменено: bedvit - 24.07.2019 12:47:14
«Бритва Оккама» или «Принцип Калашникова»?
 
Jack Famous,  Вот здесь, я уже писал на этом форуме код, в такой же парадигме, для кириллицы.
«Бритва Оккама» или «Принцип Калашникова»?
 
bedvit, и это никак не объясняет, откуда вы взяли 15, 80 и 81… С тем, как вы определяете кириллицу по разделителю "4" мне ясно, с 32 понятно - это код пробела при разделителе "0", но откуда остальные??? В таблице Юникода я что-то не то увидел…
Изменено: Jack Famous - 24.07.2019 14:12:04
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, прочитали инфо по ссылке в посте 18?
«Бритва Оккама» или «Принцип Калашникова»?
 
bedvit, нет)) я, балбес, признаю — не увидел  :D Спасибо большое  :idea:
Не могу только понять, из какой в какую систему перегонять надо… Сижу функции перебираю…

UPD: итак, в таблице Юникод коды символов совпадают с таблицей в Excel (через =СИМВОЛ() или =Chr() в VBA) с 1 по 126, дальше пляска пошла)))
В Юникоде код представлен (например, для русской "А") в десятичной (1040) или шестнадцатиричной (0410) системах счисления

Пока не могу только понять, как именно из них получить 16/4 или наоборот  :D
Вроде как это восмеричная система, но тогда почему вместо 2020 (если перевести 1040 из десятичной в восьмеричную) выдаёт эти "16 и 4"? Кратность какая-то?

UPD2: всё - я понял  :D
1040 = 16 | 4 = 16 + 256*4 (для всей кириллицы будет)
Вот только как калькулятором или функциями перегонять — всё равно непонятно  :D
Изменено: Jack Famous - 24.07.2019 16:11:51
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
bedvit написал:
1. Самая быстрая функция для расчетов в ячейке Excel, макс 32 767 знаков(VBA, COM, XLL)2. Самая быстрая функция для любого количества знаков.2.1 что бы можно использовать в VBA (VBA, COM)2.2 любой инструмент (EXE на .NET, EXE на С++)
1.Тест на 32767 знаков в каждой ячейке, на 1 млн. ячеек в Excel - 9 сек. (тест прилагаю, нужно открыть текст, нужной разрядности XLL, запустить)
2.1 - СОМ не делал, за неимением спроса, будет такая же скорость как и в п.2.2
2.2 - C#.NET Андрей, внес в твой код еще два варианта:
Скрытый текст

Net time: 1130,113 мсек; digits count: 1299456; all count: 43895808
Net time: 247,0247 мсек; digits count: 1299456; all count: 43895808 - вар2
Net time: 124,0124 мсек; digits count: 1299456; all count: 43895808 - вар3

С++
Скрытый текст

digits count: 43895808
time = 99, digits count: 1299456

В Шарпе неудобно работать со строками, их нельзя изменять (при изменении, по факту, создается новая строка. Есть структура, где все же можно - System.Text.StringBuilder, но как видим работает "оно" медленно)
В С++ строка, это лишь массив символов, можно менять что угодно, прямо на месте.
Поэтому в тестах несколько быстрее.
Изменено: bedvit - 24.07.2019 19:30:28
«Бритва Оккама» или «Принцип Калашникова»?
 
может как идея создать переменную (1)="0123456789" и потом каждый символ в тестируемом значении проверять на наличие в этой переменной (1) и если есть то сувать в еще одну переменную (2). и в конце менять значение на переменнную (2). незнаю на сколько это быстро будет)))
 
Цитата
Jack Famous написал:
функциями перегонять — всё равно непонятно  
В VBA (кроме, естественно, вызова функций рабочего листа) есть "родная" функция Hex для перевода из 10-тичной системы в 16-ричную. Для обратного перевода можно "схимичить", как указано ниже:
Код
Sub test()
  Dim s As String
  Debug.Print AscW("А")  ' выдает 1040 - номер в юникоде для заглавной "А" кириллицы в 10-тичной системе счисления
  Debug.Print Hex(1040)  ' выдаст 410 - перевод 1040 из 10- в 16-ричную
  s = "410"
  Debug.Print CDbl("&H" & s) ' выдает 1040 - обратный перевод из 16- в 10-
  Debug.Print ChrW(1040)     ' выдает заглавную "А"
End Sub
8-ричной системой ни разу в жизни в Excel не пользовался.
Изменено: sokol92 - 24.07.2019 20:28:12
Владимир
 
sokol92, за функции спасибо - почти уверен, что они быстрее функций листа  :idea:
Цитата
sokol92: 8-ричной системой ни разу в жизни в Excel не пользовался
но именно такая (кажется) получается при передаче строки байтному массиву  :D
В любом случае, что делать с этими цифрами теперь понятно.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Андрей VG, Андрей, можно еще немножко ускорить код на C#.NET, если перейти на указатели и небезопасный код (Unsafe code). см. вариант 4.
Еще ближе к С++.
upd. Немного подправил свой код.
Скрытый текст

V1-Net time: 1079,1079 мсек; digits count: 1299456; all count: 43895808
V2-Net time: 243,0243 мсек; digits count: 1299456; all count: 43895808
V3-Net time: 135,0135 мсек; digits count: 1299456; all count: 43895808
V4-Net time: 119,0119 мсек; digits count: 1299456; all count: 43895808
Изменено: bedvit - 25.07.2019 15:13:42 (upd. Немного подправил свой код.)
«Бритва Оккама» или «Принцип Калашникова»?
 
Привет, Виталий.
Огромное спасибо за исследование. Сделал в ExcelDNA, но так как исходно RegEx исходно раз в восемь медленнее, то не смотря на то, что можно задействовать IsThreadSafe, получается, что VBScript.RegExp твой код на ячейках выполнять для 32000 строк за 13 секунд, а RegEx за 20!
Цитата
onlyDigits 40,46875
Digits 25,32031
DigitOnly 12,75
DigitsXLL 0,3359375
Net RegEx 19,60938
Твой С++ вне сомнения лучший, причём деградирует заметно медленнее. RegEx на 1000000 строк минут 9 молотил, твой секунд за 30 справился - точно не засекал.
Изменено: Андрей VG - 25.07.2019 21:45:32
 
Андрей, спасибо за исследования! А DigitOnly - это код Игоря Гончаренко - выходит самый быстрый на VBA. Опять же с помощью сторонних библ. В теории я могу подлючить свою СОМ-библиотеку и обогнать в VBA - стандартную. Далее мой код на VBA, выходит 25 сек. без сторонних библиотек. Неплохо, но с библиотеками все же лучше. Считаю нужно все использовать, если есть возможность. По XLL - для интереса, возьми вариант 4 - на шарпе самый быстрый, не сильно уступает С++, заверни его в ExcelDNA. Предполагаю, отставание раза в два-пять всего лишь будет от С++.
Да C API в XLL впечатляет, конкурентов нет, кроме стандартных функций.  Хочу обогнать ВПР(), но пока проигрываю (медленнее на 46%). Не удается по указателю в Excel залесть (а разыменовывать весь массив это дорого, за счёт этого проигрываю), а встроенным функциям видимо есть доступ к памяти Excel через указатель. Или используется механизм кеширования - сейчас я о нем подумываю. Если интересно - написал даже здесь и здесь.
Изменено: bedvit - 25.07.2019 23:35:31
«Бритва Оккама» или «Принцип Калашникова»?
 
Привет!

Цитата
DopplerEffect написал:
все символы, кроме цифр?
Не забыли про
Код
Application.DecimalSeparator
?
Сравнение прайсов, таблиц - без настроек
Страницы: 1 2 След.
Наверх