Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
добавить в перекодирование латиница-кириллица количество замен символов
 
#1
24.03.2021 13:07:40
Добрый день!
Перекодирование латиница-кириллица тема избитая, есть много рабочих макросов. Использую такой, см. ниже.
Мне бы хотелось видеть Msgbox с полной информацией, сколько каких символов было заменено.
Последовательным перебором сделать несложно: вначале посчитать замены "a", потом "c" и т.д.
Через Find или циклом, но это медленно и некрасиво. Можно как-то поизящнее?
Код
Private Sub Replace_Latin_to_Russian()
    Eng = "ABEKMHOPCTYXBabekmhopctyxbr"
    Rus = "АВЕКМНОРСТУХЬавекмнорстухьг"
      
    For Each cell In ActiveSheet.UsedRange
        If cell <> "" Then
            For i = 1 To Len(cell)
                c1 = Mid(cell, i, 1)
                If c1 Like "[" & Eng & "]" Then
                    z = z + 1
                    c2 = Mid(Rus, InStr(1, Eng, c1), 1)
                    cell.Value = Replace(cell, c1, c2)
                End If
            Next i
        End If
    Next cell
Msgbox ("Количество замен: " & z)
'Msgbox ("Количество замен по символам: " ) ???
End Sub
 
 
 
#2
24.03.2021 13:25:01
Код
  Eng = "ABEKMHOPCTYXBabekmhopctyxbr"
  Rus = "АВЕКМНОРСТУХЬавекмнорстухьг"
  Dim L&(1 To Len(Eng))
  ....
  For i = 1 To Len(cell)
    c = Mid(cell, i, 1): p = InStr(Eng, c)
    If p > 0 Then
      Z = Z + 1: L(p) = L(p) + 1
      cell = Replace(cell, c, Mid(Rus, p, 1))
    End If
  Next i
Изменено: Ігор Гончаренко - 24.03.2021 13:33:28
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#3
24.03.2021 14:20:49
Игорь, благодарю за оперативный ответ, но, увы, я его не понял :(
 
 
 
#4
24.03.2021 14:35:44
Код
Sub Replace_Latin_to_Russian()
  Const eng = "ABEKMHOPCTYXBabekmhopctyxbr"
  Const Rus = "АВЕКМНОРСТУХЬавекмнорстухьг"
  Dim l&(1 To Len(eng)), cell, i&, p&, z&, c$
  For Each cell In ActiveSheet.UsedRange
    If cell <> "" Then
      For i = 1 To Len(cell)
        c = Mid(cell, i, 1): p = InStr(eng, c)
        If p > 0 Then
          z = z + 1: l(p) = l(p) + 1
          cell = Replace(cell, c, Mid(Rus, p, 1))
        End If
      Next i
    End If
  Next
  c = "Всего замен: " & z
  For i = 1 To Len(eng)
    c = c & vbLf & Mid(eng, i, 1) & ": " & l(i)
  Next
  MsgBox c
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#5
24.03.2021 14:46:44
Обалдеть! Спасибо! Красиво-то как!
 
 
 
#6
24.03.2021 17:13:17
Игорь, извините, но почему-то Ваш код только показывает количество символов, но не заменяет их. И если в одном слове несколько английских символов, то код считает только один.
В файле примера оба кода. Английские символы выделены жирным.
Изменено: ixet - 24.03.2021 17:39:35
 
 
 
#7
24.03.2021 18:00:12
и один и другой макрос пишет 8 замен, что не так?
я ничего не придумывал, добавил в ваш код, который считает количество замен, фрагмент, который считает что именно было заменено и в конце демонстрирует результаты подсчета
Изменено: Ігор Гончаренко - 24.03.2021 18:07:37
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#8
24.03.2021 19:11:25
Так это меня и удивляет. Вроде всё так, но в первом случае после макроса обычным поиском на листе латиницы не обнаруживается (это кстати сразу видно - выделение полужирным пропадает). См. первый скрин.
А после Вашего макроса "физической замены" символов не происходит. Может это зависит от версии Excel, у меня 2010?
И в слове HОРМАЛЬHЫЕ две H, а макрос считает только одну.
Изменено: ixet - 24.03.2021 19:13:37
 
 
 
#9
24.03.2021 19:44:30
а к чему это все? (эти скрины) смысл?
сумма чисел у букв не равна общему количеству замен? к чему это поток безудержный сознания в картинках?
я в фотошопе могу гораздо круче дорисовать чего угодно))
если у вас есть вопрос - вы можете сформулировать его, но, видимо, в другой теме, которая и будет посвящена вашему новому вопросу)
Изменено: Ігор Гончаренко - 24.03.2021 19:49:25
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#10
24.03.2021 19:47:05
Ок, понял. Не буду больше отвлекать. Проблема действительно не слишком значимая :) Когда разберусь, выложу здесь полностью меня устраивающий код.
Спасибо за помощь и терпение!
 
 
 
#11
24.03.2021 19:55:05
вы никого не от чего не отвлекаете, пишите сколько угодно
кто-то поймет о чем вы пишете - ответит, не поймет - пройдет мимо, в итоге вопрос останется, а ответ на него можно будет получить когда сможете сформулировать, а не сможете... никому от этого ни холодно ни жарко
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#12
24.03.2021 20:46:29
ixet, Если у вас в одной ячейке несколько одинаковых символов на английском, то после использования замены вы их все меняете на русский шрифт, по этому они уже второй раз в слове не заменяются. Подправьте немного код и будет считать правильно
Код
            'cell = Replace(cell, c, Mid(Rus, p, 1))
            cell.Value = Application.Substitute(cell, c, Mid(Rus, p, 1), 1)
Изменено: gling - 24.03.2021 23:10:20
 
 
 
#13
24.03.2021 23:38:40
gling, Ваш вариант работает именно так как надо. Благодарю!
Простые vba циклы пишу, но такие тонкости пока трудно. Буду учиться
 
 
 
Страницы: 1
Наверх