我在Excel中制作语言翻译VBA案例时遇到困难

我正在尝试用Vba案例来为一个文件列表生成一个自动语言翻译代码，该列表中包含了内部项目，但是有些行有不止一个项目，我需要Vba在同一个单元格中分别翻译其中的每一个项目，我找到的解决方案是写下每一种可能性（在翻译中顺序无关紧要）以下是我使用的行：

Sub Traduccione()
Select Case activecell.Offset.Value
    Case "Cadeiras"
    Selection.Value = "Chairs"
Case "Cadeira"
Selection.Value = "Chair"
Case "Criado mudo", "Criado-mudo"
Selection.Value = "Night stand"
Case "Mesa"
Selection.Value = "Table"
Case "Mesas", "mesas"
Selection.Value = "Tables"
Case "Mesa de canto"
Selection.Value = "End table"
Case "Mesinha"
Selection.Value = "Small table"
Case "Cabeceira", "cabeceira"
Selection.Value = "Headboard"
Case "Cabeceiras", "cabeceiras" 
'the following lines are an example of my struggle:
Case "Mochila, documentos e roupas", "Mochila, roupas e documentos", "Documentos, mochilas e roupas", "Documentos, roupas e mochilas", "Roupas, mochilas e documentos", "Roupas, documentos e mochilas"
Selection.Value = "Bags, documents and clothes"

Case "Travesseiro, bolsas, sapatos e roupas", "Travesseiro, bolsas, roupas e sapatos", "Travesseiro, sapatos, bolsas e roupas", "Travesseiro, sapatos, roupas e bolsas", "Travesseiro, roupas, bolsas e sapatos", "Travesseiro, roupas, sapatos e bolsas", "Bolsas, travesseiro, sapatos e roupas", "Bolsas, travesseiro, roupas e sapatos", "Bolsas, sapatos, travesseiro e roupas", "Bolsas, sapatos, roupas e travesseiro", "Bolsas, roupas, travesseiro e sapatos", "Bolsas, roupas, sapatos e travesseiro", "Sapatos, travesseiro e bolsas, roupas", "Sapatos, travesseiro, roupas e bolsas", "Sapatos, bolsas, travesseiro e roupas", "Sapatos, bolsas, roupas e travesseiro", "Sapatos, roupas, travesseiro e bolsas", "Sapatos, roupas, bolsas e travesseiro", "Roupas, travesseiro, bolsas e sapatos", "Roupas, travesseiro, sapatos e bolsas", "Roupas, bolsas, travesseiro e sapatos", "Roupas, bolsas, sapatos e travesseiro", "roupas, sapatos, travesseiro e bolsas", "Roupas, sapatos, bolsas e travesseiro"
Selection.Value = "Pillow, bags, shoes and clothes"
       End Select

End Sub

这个清单上还有1000多个项目，这只是一个让你聪明的头脑去理解的样本

我想知道是否有更好的方法来做这件事，因为我找不到更好的解决方案，我想应该有更好的方法来做，但我就是找不到，如果有人有类似的问题或知道如何使这项工作更容易，你能分享吗？你会让我的生活更轻松

我是一个新手，在这里和编码，所以请耐心，如果我做了一个奇怪的错误：b

---

感谢大家阅读。

这里是一个使用dictionary对象和string

Replace

函数的示例。这不会试图翻译字典中没有的任何单词

Sub foo()

Dim translate As Object 'Scritping.Dictionary

Set translate = CreateObject("Scripting.Dictionary")

' Define your translation terms
' here I use lower-case for everything, assuming that case-sensitivity does not matter
    translate("cadeira") = "chair"
    translate("cadeiras") = "chairs"
    translate("criado mudo") = "night stand"
    translate("criado-mudo") = "night stand"
    translate("mesa") = "table"
    translate("mesas") = "tables"

    ' etc...
    ' Add more translation items as needed

Dim spWords As String
Dim enWords As String

spWords = LCase(ActiveCell.Value)

For Each spWord In translate.Keys()
    If InStr(spWords, spWord) Then
        enWords = Replace(Replace(spWords, spWord, translate(spWord), InStr(spWords, spWord)), " e ", "and")
        ActiveCell.Offset(0, 1).Value = enWords

    End If
Next
End Sub

---

维护这样的列表通常不是通过将文本硬编码到程序中来完成的。相反，数据通常存储在更持久的地方，如数据库，然后程序通过执行查询访问数据库

除此之外，您应该将数据存储在某个地方，因为维护Select/Case是不可持续的。您可以创建如下所示的词典：

 Dim MyDictionary As Object
 Set MyDictionary = CreateObject("Scripting.Dictionary")

 MyDictionary.Add "Cadeiras", "Chairs"

 For Each key In MyDictionary.Keys
      ' theInput is the data that is being looked up
      If theInput = key Then
         Selection.Value = MyDictionary.Item(key)
      End If
 Next word

然后按如下方式添加每对数据：

 Dim MyDictionary As Object
 Set MyDictionary = CreateObject("Scripting.Dictionary")

 MyDictionary.Add "Cadeiras", "Chairs"

 For Each key In MyDictionary.Keys
      ' theInput is the data that is being looked up
      If theInput = key Then
         Selection.Value = MyDictionary.Item(key)
      End If
 Next word

填充字典后，您可以在字典中循环查找匹配项，如下所示：

 Dim MyDictionary As Object
 Set MyDictionary = CreateObject("Scripting.Dictionary")

 MyDictionary.Add "Cadeiras", "Chairs"

 For Each key In MyDictionary.Keys
      ' theInput is the data that is being looked up
      If theInput = key Then
         Selection.Value = MyDictionary.Item(key)
      End If
 Next word

这个解决方案（把它放在一个模块上，即使我更喜欢类实现）是双向的

Option Explicit
Option Base 1

'Note : Specify your language. Watch out first native language should be 0
Public Enum tr_language
    english = 0
    french = 1
End Enum

Public Function dicOfTerms() As String()
'Note : Your translate Dictionary. Dim your array (carefull Option base 1)
Dim trData(2) As String

trData(1) = "dog;chien"
trData(2) = "mug;tasse"

dicOfTerms = trData
End Function

Public Function myTerm(ByVal targetString As String, Optional translatelanguage As tr_language = 1) As String
Dim tmp() As String

'Note : Warning  vbBinaryCompare is case sensitive | vbTextCompare is not case sensitive !
tmp = Filter(dicOfTerms, targetString, True, vbTextCompare)
'Note : return tarrgetString if not translation !
If UBound(tmp) < 0 Then myTerm = targetString Else myTerm = Split(tmp(0), ";")(translatelanguage)

End Function

Sub test_translate()
    Debug.Print myTerm("dog", french)
End Sub

选项显式
选项基数1
'注意：指定您的语言。注意：第一种母语应为0
公共枚举语言
英语=0
法语=1
结束枚举
公共函数dicOfTerms（）作为字符串（）
注：你的翻译词典。调暗您的阵列（小心选项基础1）
Dim trData（2）作为字符串
trData（1）=“狗；钱”
trData（2）=“杯子；塔塞”
双OFTERMS=trData
端函数
公共函数myTerm（ByVal targetString作为字符串，可选translatelanguage作为tr_language=1）作为字符串
Dim tmp（）作为字符串
'注意：警告vbBinaryCompare区分大小写| vbTextCompare不区分大小写！
tmp=过滤器（双术语、targetString、True、vbTextCompare）
'注意：如果不是翻译，则返回tarrgetString！
如果UBound（tmp）<0，则myTerm=targetString，否则myTerm=Split（tmp（0），“；”）（translatelanguage）
端函数
子测试_translate（）
调试。打印myTerm（“狗”，法语）
端接头

为什么不使用字典而不是case语句的级联？并对逗号分隔的列表使用

Split

函数。如何使用列表在工作表中构建一个表并使用。通过这种方式，您可以完全避免VBA，并且可以更轻松地创建列表。（只需在Excel单元格中键入即可）。虽然始终是属性的一部分，但属性并不总是与相同；e、 g.选择可以是多个单元格。无论您是将翻译作为键和项存储在字典中，还是存储在一对数组中，甚至是将工作表放入二维数组中，我认为您最好使用LookAt:=xlPart对整个字符串进行搜索。您不需要Cadeira/椅子，因为用椅子替换Cadeira会使s。区分大小写可以忽略。必须注意确保按照正确的顺序更换。将翻译显示为示例数据表。您认为我应该在access上构建它吗？我从昨天开始就在努力学习，试着看看是否会更容易。要正确地做，无疑会有更多的工作要做。但是，这是正确的方法。只要不让多个用户同时访问数据库，您就可以使用Access。我对这种编码方式有很好的感觉/\，我不知道如何使用object，也不知道如何使用object，我会尝试学习它，因为当我试图运行代码时，它返回了一个错误“每个变量都需要是一个变量或对象”更改为

Dim spWord作为变体

我用上面提到的更改修改了答案。伙计！！我不敢相信你有多了不起！！它正在寻找和翻译每个细胞完全符合我的要求！你真了不起，大卫！我只需要为这类行找到一个解决方案：translate（“criado mudo”）=“night stand”，因为它首先查找“criado”，然后查找“mudo”，而不是同时查找这两个词。W，您的代码看起来太高级了，我无法理解以下行中的错误“用户定义的类型未定义”：公用函数myTerm（ByVal targetString作为字符串，可选translatelanguage作为tr_language=1）作为字符串您知道发生了什么吗？您应该在模块顶部放置“Public Enum tr_language…”（仅在“Option Base 1”之后）