是否有一种有效的方法来结合大量的替换和替换?



我有很多用代码编写的数据,我需要使其更具可读性。为此,我在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

您可以使用以下内容。需要对新单元进行维护,所以我可能也会采用表方法。可能最好在从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

使用like so

GetReplacementUnits("CENTIMETRE")返回cm

根据大家的建议,我做了如下决定:

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是一个表,第一列是每个可能的代码,第二列给出相应的术语。在上下文中,这实际上比替换部分代码更有意义。它也更容易添加我以后可能遇到的新变量。

谢谢大家的意见!

最新更新