Excel VBA关键字重音变化

我需要一个代码，可以为我提供带有口音的单词的变体。我来自巴西，你知道，我们的词汇表中充满了这些

假设我从C8开始输入“cartão de crédito”（信用卡）和“avião”（飞机），现在，从G8开始，我需要填写表格，给出这些单词的重音的所有可能变化，这将给我以下信息：

卡托·德克雷迪托酒店 信用卡 卡托德克雷迪托酒店 信用卡托德信用卡 阿维昂 阿维奥

经过长时间的研究，我确实想出了一些东西。因为我不是专家，所以代码的某些部分我不知道它是如何工作的

问题是，我的代码在Windows上运行得很好，但在Excel for MAC上，代码运行，但没有提供变体，它只重复我在C列中插入的内容

我希望有一个替代的代码，这样我就可以比较我的代码，看看我可能做错了什么。你能帮我吗

这是我的代码（记住，它适用于Windows）

Dim A（0到100，0到1）作为字符串
将零件（0到20，0到1）的尺寸标注为字符串
将最后一部分设置为整数
Dim MaxA作为整数
Dim CurRow作为整数
暗淡单元格作为范围
将rgColuna1设置为字符串
Dim RGCOL最终为字符串
亚变形虫（）
“定义为变量”
coluna1=“C8”
colunfinal=“G8”
rgColuna1=“C8:C1048576”
rgcolunfinal=“G8:G1048576”
Application.ScreenUpdating=False
“查证你是杰拉多·埃斯塔·瓦齐奥
如果范围（coluna1）=“”，则
MsgBox“A planilha estávazia.”和vbNewLine和“Preencha A primeira coluna.”，vbInformation，“planilha vazia”
其他的
“Seleciona coluna”G“a partir da linha 8 e limpa todo o conteudo
范围（rgcolunfinal）。选择
选择.ClearContents
“定义参数变量”
A（0，0）=Chr（227）ã
A（1，0）=Chr（225）'A
A（2，0）=Chr（224）'A
A（3，0）=Chr（226）'
A（4，0）=Chr（228）ä
A（5，0）=Chr（231）ç
A（6，0）=Chr（233）'e
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）'o
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）'u
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
电流=8
“变形金刚
如果范围（coluna1）“”和范围（“C9”）=”，则
范围（coluna1）。选择
其他的
范围（coluna1）。选择
范围（选择，选择。结束（xlDown））。选择
如果结束
Transforma：
对于选择中的每个单元格。单元格
如果cell.HasFormula=False，则
单元=LCase（单元）
如果结束
下一个
“Comeca checagem para variacao
Checagem：
对于范围内的每个p（rgColuna1）
如果p.Value=”“，则
退出
如果结束
对于i=0到20
第（i，0）部=“”
第（i，1）部
接下来我
lasti=1
最后部分=0
对于i=1到Len（p）
Letra=Mid（p，i，1）
对于j=0到MaxA
如果Letra=A（j，0），则
lastpart=lastpart+1
部分（lastpart，0）=中间（p，lasti，i-lasti+1）
部分（lastpart，1）=中间（p，lasti，i-lasti）&A（j，1）
lasti=i+1
如果结束
下一个j
接下来我
lastpart=lastpart+1
部分（lastpart，0）=中间（p，lasti，i-lasti+1）
零件（lastpart，1）=中间（p，lasti，i-lasti+1）
替换为“”，1
下一个p
“赛莱西奥纳和科皮亚和孔杜多决赛
范围（colunfinal）。选择
范围（选择，选择。结束（xlDown））。选择
选择，复制
范围（“A1”）。选择
Application.ScreenUpdating=True
如果结束
端接头
私有函数ReplaceAcc（之前，pIndex）作为字符串
“定义o posicionamento da coluna决赛：Linha 8 da coluna 7
如果pIndex=lastpart，则
ActiveSheet.Cells（CurRow，7）.Value=Before&Part（pIndex，0）
电流=电流+1
其他的
更换零件之前的ACC（pIndex，0），pIndex+1
更换零件之前的ACC（pIndex，1），pIndex+1
如果结束
端函数

让它开始工作。问题在于从一个系统到另一个系统的Chr（）代码不同。我不知道这是从Excel Win到Excel OSX还是仅仅是语言设置。例如：“ã”是Excel For Windows PT-BR上的Chr（227），英语中的Chr（139）是Excel OSX。希望这有助于与Chr（）发生冲突的人。我花了很长时间才弄明白这一点。

我建议让代码审查清理您的Windows工作代码，然后将其移植到Mac上，看看清理代码是否有帮助。有许多事情可以很容易地清理，比如定义一个范围对象变量，而不是通过字符串传递范围并使用范围（string）。嘿，克里斯马斯，谢谢你指出了方向。我现在遇到的问题是知识范围：我确实根据我所知道的和我所能做的清理了代码，但对于其他方面来说，这有点困难。我将看一看“不使用选择”。我使用了Range（string）作为一种通过变量改变单元格一次的方法，我将对此进行观察以使其工作。问题在于从一个系统到另一个系统的Chr（）代码不同。我不知道这是从Excel Win到Excel OSX还是仅仅是语言设置。ã是Excel for Windows PT-BR中的Chr（227）和Excel OSX中的英文Chr（139）。希望这能帮助那些与Chr（）发生冲突的人

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