我无法在Excel中进行语言翻译VBA案例

我试图使VBA的情况下，自动语言翻译代码的文件列表填充房屋项目，但一些行有不止一个项目，我需要VBA在同一单元格中单独翻译他们中的每一个，我find的解决scheme写下所有的可能性（在翻译顺序并不重要）这里是使用的线：

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个项目，这只是一个让你聪明的头脑理解的样本。

我想知道是否有更好的方法来做到这一点，因为我无法find更好的解决scheme，我认为应该有一个更好的方法来做到这一点，但我不能find它，如果有人有类似的问题或知道如何使这个工作更容易，你可以请分享？ 你会让我的生活更轻松。

我是一个新手，在编码方面，如果我犯了一个奇怪的错误，请耐心等待

谢谢大家阅读。

Answer 1

这是一个使用字典对象和stringReplacefunction的例子。 这不会试图翻译任何不在字典中的单词。

 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 

Answer 2

保持这样的列表通常不是通过将文字硬编码到程序中来完成的。 相反，数据通常存储在更加耐用的地方，就像数据库一样，然后程序通过执行查询来访问数据库。

除此之外，您应该将数据存储在某处，因为保持Select / Case不可持续。 你可以像这样创build一个字典：

  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 

Answer 3

这个解决scheme（把它放在一个模块上，即使我更喜欢类的实现）在两种方式工作！

 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