Добрый день. Уважаемые участники форума. Передо мной стоит задача создать пользовательскую формулу в excel с помощью VBA, которая ищет наличие любой арабской цифры в ячейке заданных столбцов. пример прилагается. Нашел код VBA который удаляет все арабские буквы из ячейки.
Код VBA [vba]
Код
Function TrimArabic(txt) As String '''' ' Removes all characters U+0600 and higher from txt. ' ' Designed to remove Arabic characters, it also removes Chinese and ' many, many other language group characters from txt. '''' Dim glyph As String Dim i As Long
For i = 1 To Len(txt) glyph = Mid(txt, i, 1) If glyph < ChrW(&H600) Then TrimArabic = TrimArabic & glyph End If Next i End Function ''''
Sub RemoveArabic() '''' ' Removes all characters above U+05FF from a selected range. ' ' Requires TrimArabic(). '''' Dim cell As Range
If TypeName(Selection) <> "Range" Then Exit Sub
For Each cell In Selection cell.Value = TrimArabic(cell.Value) Next cell End Sub
[/vba] Я использовал функцию VBA TrimArabic2(txt) и пыталься ее исправить, но проблема заключается в следующем, если есть в ячейке смешанные символы, например, русские буквы или английские, то значение всегда получается 0. И еще в функции есть только возможность объединить ячейки только через & в скобках (A4&B4), а надо как в обычной функции через ; (A4;B4) чтобы можно было выбрать любой дипазон как сплошной A4:D4, так и выборочный A4;B4;C4 например.
есть ссылка на источник кода My WebPage Прошу помочь, любые советы очень будут полезны!!!
Добрый день. Уважаемые участники форума. Передо мной стоит задача создать пользовательскую формулу в excel с помощью VBA, которая ищет наличие любой арабской цифры в ячейке заданных столбцов. пример прилагается. Нашел код VBA который удаляет все арабские буквы из ячейки.
Код VBA [vba]
Код
Function TrimArabic(txt) As String '''' ' Removes all characters U+0600 and higher from txt. ' ' Designed to remove Arabic characters, it also removes Chinese and ' many, many other language group characters from txt. '''' Dim glyph As String Dim i As Long
For i = 1 To Len(txt) glyph = Mid(txt, i, 1) If glyph < ChrW(&H600) Then TrimArabic = TrimArabic & glyph End If Next i End Function ''''
Sub RemoveArabic() '''' ' Removes all characters above U+05FF from a selected range. ' ' Requires TrimArabic(). '''' Dim cell As Range
If TypeName(Selection) <> "Range" Then Exit Sub
For Each cell In Selection cell.Value = TrimArabic(cell.Value) Next cell End Sub
[/vba] Я использовал функцию VBA TrimArabic2(txt) и пыталься ее исправить, но проблема заключается в следующем, если есть в ячейке смешанные символы, например, русские буквы или английские, то значение всегда получается 0. И еще в функции есть только возможность объединить ячейки только через & в скобках (A4&B4), а надо как в обычной функции через ; (A4;B4) чтобы можно было выбрать любой дипазон как сплошной A4:D4, так и выборочный A4;B4;C4 например.
есть ссылка на источник кода My WebPage Прошу помочь, любые советы очень будут полезны!!! Zaga83
Добрый день. Подкорректировал, правда только для сплошных диапазонов [vba]
Код
Function TrimArabic2(ByRef r As Range) As Boolean Dim буква As String Dim i As Long Dim txt As String Dim cl As Range Dim ar As Range TrimArabic2 = False For Each cl In r.Cells txt = cl.Value For i = 1 To Len(txt) буква = Mid(txt, i, 1) If буква > ChrW(&H600) Then TrimArabic2 = True Exit Function End If Next i Next cl End Function
[/vba]
Добрый день. Подкорректировал, правда только для сплошных диапазонов [vba]
Код
Function TrimArabic2(ByRef r As Range) As Boolean Dim буква As String Dim i As Long Dim txt As String Dim cl As Range Dim ar As Range TrimArabic2 = False For Each cl In r.Cells txt = cl.Value For i = 1 To Len(txt) буква = Mid(txt, i, 1) If буква > ChrW(&H600) Then TrimArabic2 = True Exit Function End If Next i Next cl End Function
sboy, Спасибо, работает функция!!! в принципе и для сплошных дипазонов тоже подходит... как я понял 2 "--" в строке формулы функции булево значение преобразуют в число. Спасибо еще раз огромное!!!
sboy, Спасибо, работает функция!!! в принципе и для сплошных дипазонов тоже подходит... как я понял 2 "--" в строке формулы функции булево значение преобразуют в число. Спасибо еще раз огромное!!!Zaga83
Добрый день. sboy, продолжил тестирование Вашей функции на другом примере а все равно выдает цифру 1 там где нет вроде арабских букв?
Проверил каждую ячейку в дипазоне B7, C7, D7, E7, и только на E7 Выдает значение 1 хотя там вроде нет арабских букв? Поскажите в чем проблема? Может какие скрытые символы на арабском языке? Файл прилагаю с примером?
Добрый день. sboy, продолжил тестирование Вашей функции на другом примере а все равно выдает цифру 1 там где нет вроде арабских букв?
Проверил каждую ячейку в дипазоне B7, C7, D7, E7, и только на E7 Выдает значение 1 хотя там вроде нет арабских букв? Поскажите в чем проблема? Может какие скрытые символы на арабском языке? Файл прилагаю с примером? Zaga83
RAN, Спасибо за подсказку. Сначала через Debug.Print просмотрел что выдает значение по столбцу E. это были знаки припинания Запятая, вопросительный знак и тд. и все они были больше &H600 Потом посмотер таблицу Юникода. В ней нашел с какого по какой занимают арабские буквы? Оказывется 600 до 700 изменил код на такую строку
[vba]
Код
If буква > ChrW(&H600) And буква < ChrW(&H700) Then 'Debug.Print буква 'Debug.Print AscW(буква)
[/vba] теперь функция не учитывет знаки припинания. И ищет только арабские буквы, что требовалось по заданию. Спасибо за помощь RAN,
RAN, Спасибо за подсказку. Сначала через Debug.Print просмотрел что выдает значение по столбцу E. это были знаки припинания Запятая, вопросительный знак и тд. и все они были больше &H600 Потом посмотер таблицу Юникода. В ней нашел с какого по какой занимают арабские буквы? Оказывется 600 до 700 изменил код на такую строку
[vba]
Код
If буква > ChrW(&H600) And буква < ChrW(&H700) Then 'Debug.Print буква 'Debug.Print AscW(буква)
[/vba] теперь функция не учитывет знаки припинания. И ищет только арабские буквы, что требовалось по заданию. Спасибо за помощь RAN,Zaga83
Сообщение отредактировал Zaga83 - Суббота, 11.11.2017, 19:40