Question

我试图让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

感谢大家的阅读。

Answer 1

以下是使用字典对象和字符串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

Answer 2

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

除此之外，您应该将数据存储在某处，因为维持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

Answer 3

这个解决方案（把它放在模块上，即使我更喜欢类实现）也可以双向工作！

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

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

3 个答案: