Excel VBA Keyword Accent Variation

Question

Мне нужен код, который мог бы предоставить мне варианты слов с акцентами. Я из Бразилии и наш словарь, как вы знаете, полон этих.

Предположим, что я печатаю «карточку de crédito» (которая является кредитной картой) и «avião» (самолет) с C8 вперед, а теперь, начиная с G8, мне нужно проложить лист, чтобы дать все возможные варианты для акцентов из этих слов, которые дали бы мне следующее:

Cartão де Кредит Cartão де Кредит Cartão де Кредит Cartão де Кредит avião aviao

я придумал что-то я положил вместе после долгой исследование. Поскольку я нет и эксперт, есть некоторые части кода, которые я точно не знаю, как это работает.

Проблема заключается в том, что мой код работает на Windows, очень тонкой, но в Excel для MAC, код работает, но не дает мне варианты, это всего лишь повторяет то, что я вставил на колонке C.

Я надеясь иметь альтернативный код, чтобы я мог сравниться с моим и видеть, что я мог сделать неправильно. Вы можете мне помочь?

Вот мой код (помните, что он работает на Windows,)

Dim A(0 To 100, 0 To 1) As String 
Dim Part(0 To 20, 0 To 1) As String 
Dim lastpart As Integer 
Dim MaxA As Integer 
Dim CurRow As Integer 
Dim cell As Range 
Dim rgColuna1 As String 
Dim rgColunafinal As String 

Sub VariarAcentos() 

' Define as variaveis 
coluna1 = "C8" 
colunaFinal = "G8" 
rgColuna1 = "C8:C1048576" 
rgColunafinal = "G8:G1048576" 

Application.ScreenUpdating = False 

' Verifica se o gerador esta vazio 
If Range(coluna1) = "" Then 
MsgBox "A planilha está vazia." & vbNewLine & "Preencha a primeira coluna.", vbInformation, "Planilha vazia" 

Else 

' Seleciona coluna "G" a partir da linha 8 e limpa todo o conteudo 
Range(rgColunafinal).Select 
Selection.ClearContents 

' Define regra para variacoes 
A(0, 0) = Chr(227) ' ã 
A(1, 0) = Chr(225) ' á 
A(2, 0) = Chr(224) ' à 
A(3, 0) = Chr(226) ' â 
A(4, 0) = Chr(228) ' ä 
A(5, 0) = Chr(231) ' ç 
A(6, 0) = Chr(233) ' é 
A(7, 0) = Chr(232) ' è 
A(8, 0) = Chr(234) ' ê 
A(9, 0) = Chr(235) ' ë 
A(10, 0) = Chr(237) ' í 
A(11, 0) = Chr(236) ' ì 
A(12, 0) = Chr(238) ' î 
A(13, 0) = Chr(239) ' ï 
A(14, 0) = Chr(241) ' ñ 
A(15, 0) = Chr(243) ' ó 
A(16, 0) = Chr(242) ' ò 
A(17, 0) = Chr(244) ' ô 
A(18, 0) = Chr(245) ' õ 
A(19, 0) = Chr(246) ' ö 
A(20, 0) = Chr(250) ' ú 
A(21, 0) = Chr(249) ' ù 
A(22, 0) = Chr(251) ' û 
A(23, 0) = Chr(252) ' ü 
A(24, 0) = Chr(253) ' ý 
A(25, 0) = Chr(255) ' ÿ 

A(0, 1) = "a" 
A(1, 1) = "a" 
A(2, 1) = "a" 
A(3, 1) = "a" 
A(4, 1) = "a" 
A(5, 1) = "c" 
A(6, 1) = "e" 
A(7, 1) = "e" 
A(8, 1) = "e" 
A(9, 1) = "e" 
A(10, 1) = "i" 
A(11, 1) = "i" 
A(12, 1) = "i" 
A(13, 1) = "i" 
A(14, 1) = "n" 
A(15, 1) = "o" 
A(16, 1) = "o" 
A(17, 1) = "o" 
A(18, 1) = "o" 
A(19, 1) = "o" 
A(20, 1) = "u" 
A(21, 1) = "u" 
A(22, 1) = "u" 
A(23, 1) = "u" 
A(24, 1) = "y" 
A(25, 1) = "y" 

MaxA = 26 
CurRow = 8 

' Transforma valores em minusculas 
If Range(coluna1) <> "" And Range("C9") = "" Then 
Range(coluna1).Select 
Else 
Range(coluna1).Select 
Range(Selection, Selection.End(xlDown)).Select 
End If 

Transforma: 
For Each cell In Selection.Cells 
If cell.HasFormula = False Then 
cell = LCase(cell) 
End If 
Next 

' Comeca checagem para variacao 
Checagem: 
For Each p In Range(rgColuna1) 
    If p.Value = "" Then 
     Exit For 
    End If 

    For i = 0 To 20 
     Part(i, 0) = "" 
     Part(i, 1) = "" 
    Next i 

    lasti = 1 
    lastpart = 0 
    For i = 1 To Len(p) 
     Letra = Mid(p, i, 1) 
     For j = 0 To MaxA 
      If Letra = A(j, 0) Then 
       lastpart = lastpart + 1 
       Part(lastpart, 0) = Mid(p, lasti, i - lasti + 1) 
       Part(lastpart, 1) = Mid(p, lasti, i - lasti) & A(j, 1) 
       lasti = i + 1 
      End If 
     Next j 
    Next i 
    lastpart = lastpart + 1 
    Part(lastpart, 0) = Mid(p, lasti, i - lasti + 1) 
    Part(lastpart, 1) = Mid(p, lasti, i - lasti + 1) 

    ReplaceAcc "", 1 

Next p 

' Seleciona e copia o conteudo final 
Range(colunaFinal).Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 

Range("A1").Select 

Application.ScreenUpdating = True 

End If 

End Sub 
Private Function ReplaceAcc(Before, pIndex) As String 
    ' Define o posicionamento da coluna final: Linha 8 da coluna 7 
    If pIndex = lastpart Then 
     ActiveSheet.Cells(CurRow, 7).Value = Before & Part(pIndex, 0) 
     CurRow = CurRow + 1 
    Else 
     ReplaceAcc Before & Part(pIndex, 0), pIndex + 1 
     ReplaceAcc Before & Part(pIndex, 1), pIndex + 1 
    End If 

End Function 

Answer 1

Понял работать. Проблема была в коде Chr(), которые не совпадают с одной системой на другую. Я не знаю, является ли это от Excel Win до Excel OSX или только языковых настроек. Например: «ã» - это Chr (227) для Excel для Windows PT-BR и Chr (139) для Excel OSX на английском языке. Надеюсь, это поможет кому-то, кто возится с Chr(). Принял мне много времени, чтобы понять это.