Есть ли более быстрый способ замены акцентированных символов? - PullRequest
Новая
       12

Есть ли более быстрый способ замены акцентированных символов?

0 голосов
/ 04 февраля 2020

У меня есть этот код, который заменяет все акцентированные символы, кроме строки 6. Однако этот макрос занимает много времени, потому что он проходит через каждую ячейку / букву, есть ли способ сделать это быстрее, заставляя игнорировать ячейки, которые не в них нет акцентов? 

Const sFm As String = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const sTo As String = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"

Dim i As Long, employeews As Worksheet
Dim rowsix() As Variant

Set employeews = DestWb.Sheets(1)

'Don't replace row 6
rowsix = employeews.Rows(6).Value


For i = 1 To Len(sFm)
    employeews.Cells.Replace Mid(sFm, i, 1), Mid(sTo, i, 1), LookAt:=xlPart, MatchCase:=True
Next i

employeews.Rows(6).Value = rowsix

Ответы [ 2 ]

1 голос
/ 04 февраля 2020

Добавление комментария в качестве ответа, чтобы код был более читабельным:

Я хотел бы выбрать диапазон, в котором я хочу заменить значения, затем l oop через специальные символы для замены, в целом, в пределах досягаемости. Единственное реальное предостережение, которое нужно помнить, это то, что будет влиять на формулы. 

dim accentArr as variant, noAccentArr as variant
'accent and noaccent need to have same upper bound for this approach!
accentArr = Array("Š","Ž","š") 'quick mockup
noAccentArr = Array("S","Z","s") 
dim i as long
For i = lbound(accentArr) to ubound(accentArr)
    ws.range("a1:z5").replace(accentArr(i),noAccentArr(i))
Next i

Вместо того, чтобы проходить символ за символом в ячейке, вы по крайней мере делаете массовую замену для указанных c символы ... это также позволяет вашему Range() начинаться со строки 7, чтобы не включать строку 6.

Postscript, см .: Разбить строку на массив символов? если вы хотите использовать существующую строку без необходимости вручную разбивать строку символов на массив.

0 голосов
/ 04 февраля 2020

В соответствии с тем, что говорят все остальные, и на самом деле не зная, что вы считаете плохой работой, вы можете попробовать что-то вроде этого. Он использует dictionary, который заполняется строками from и to, разделяется на символы и их замены, где from - это key, а to - item. keys() и items() словаря массив, так что используйте их вместо того, чтобы разрезать строку каждый раз, и словарь снова будет доступен. 

Private d As Scripting.Dictionary

Const sFrom As String = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const sTo As String = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"

Sub PopulateReplacements()

Dim s As String
Dim l As Long

Set d = New Scripting.Dictionary

For l = 1 To Len(sFrom)
    If Not d.Exists(Mid(sFrom, l, 1)) Then _
                d.Add Mid(sFrom, l, 1), Mid(sTo, l, 1)
Next l

End Sub

Sub TestReplacing()

Dim s As String
Dim l As Long

s = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔ"
s = "_Ÿ_À_Á_Â_Ã_Ä_Å_Ç_È_É_Ê_Ë_Ì_Í_Î_Ï_Ð_Ñ_"
s = sFrom

If d Is Nothing Then
    PopulateReplacements
End If

For l = 0 To UBound(d.Keys())
    s = Replace(s, d.Keys()(l), d.Items()(l))
Next l

Debug.Print s

End Sub
...