有没有一种有效的方法来组合大量的替换和替换?

Is there an efficient way to combine numerous subtitutions and replacements?

我有很多用代码编写的数据,我需要提高它们的可读性。为此,我在vba中使用了replace,特别是因为有很多可能的代码需要删除或替换为不同的符号,我还需要添加一些可能的文本。

下面的 UDF 可以工作,但每当我发现需要替换的新代码部分时,我都必须编写另一个完整的 'Let#' 来补偿。我觉得有更好的方法来编写这个函数,所以我想知道是否有人可以提供帮助。

Function Unit(Req_Header As String) As String

Dim Func As String
Dim Amount As String

Func = AkeFind(Req_Header)     'AkeFind is a different UDF that looks up the correct string in a dataset (and returns as a string)

Dim LetA As String
Dim LetB As String
Dim LetC As String
Dim LetD As String
Dim LetE As String
Dim LetF As String

LetA = Replace(Func, "formaat_papier_", "")
LetB = Replace(LetA, "motief_", "")
LetC = Replace(LetB, "materiaal_", "")
LetD = Replace(LetC, "vorm_", "")
LetE = Replace(LetD, "_", " ")
LetF = Replace(LetE, "•", "-")

Amount = LetF

    Select Case Amount
    Case "CENTIMETER", "Centimeter", "centimeter"
        Unit = "cm"
    Case "MILLIMETER", "Millimeter", "millimeter"
        Unit = "mm"
    Case "METER", "Meter", "meter"
        Unit = "m"
    Case "CENTILITER", "Centiliter", "centiliter"
        Unit = "cl"
    Case "MILLILITER", "Milliliter", "milliliter"
        Unit = "ml"
    Case "LITER", "Liter", "liter"
        Unit = "l"
    Case "KILOGRAM", "Kilogram", "kilogram"
        Unit = "kg"
    Case "MILLIGRAM", "Milligram", "milligram"
        Unit = "mg"
    Case "GRAM", "Gram", "gram"
        Unit = "g"
    Case "PIECE", "Piece", "piece"
        Unit = "Stuks"
    Case "plastic", "kunstof"
        Unit = "Kunststof"
    Case "metaal", "staal"
        Unit = "Metaal"
    Case Else
        Unit = Amount
    End Select

End Function

您可以按照这些思路使用一些东西。需要维护新单元,所以我也可能会采用 table 方法。可能最好在从 aReplace 获取之前分离出函数的匹配部分并测试错误。

Function GetReplacementUnits(strInputUnit As String)

Dim aOrig() As Variant
Dim aReplace() As Variant

aOrig = Array("CENTIMETRE", "KILOGRAM", "METER")
aReplace = Array("cm", "Kg", "m")

GetReplacementUnits = Application.Index(aReplace, Application.Match(UCase(strInputUnit), aOrig, 0), 1)

End Function

这样使用

GetReplacementUnits("CENTIMETRE")returns厘米

所以根据大家的建议我做出了以下几点:

Function Unit(Req_Header As String) As String

Dim Func As String

Func = LCase$(AkeFind(Req_Header))

Dim Rem_Range As Range
Dim Replc_Range As Range
Dim a_Nr As Integer

Set Rem_Range = Sheets("Variables").Range("Rem_Table[Rem_Code]")
Set Replc_Range = Sheets("Variables").Range("Rem_Table[Replc]")

For Each a In Rem_Range
    If Func = a Then
        Unit = a.Offset(0, 1).Value
        Exit For
    Else
        Unit = Func
    End If
Next a

End Function

Rem_Table 是一个 table,第一列是每个可能的代码,第二列给出适当的术语。在上下文中,使用而不是替换部分代码实际上更有意义。添加我以后可能会遇到的新变量也更容易。

感谢大家的意见!