Question

所以我正在编写一个宏来将零件号从简单的零件号转换为扩展的零件号。我现在的代码无论如何都不优雅，但它正在发挥作用。

假设我有一个部件号A1001，我需要它成为FSAEM-16-121-BR-A0001-AA，其中BR来自第一个1，其余的部件号保持不变，我有这个代码

Sub Part_Number_Replacer()
With ActiveSheet.Columns("B:B")
.Replace "A100", "FSAEM–16–121–BR–A000", xlPart
.Replace "100", "FSAEM–16–121–BR–0000", xlPart
.Replace "A200", "FSAEM–16–121–EN–A000", xlPart
.Replace "200", "FSAEM–16–121–EN–0000", xlPart
.Replace "A300", "FSAEM–16–121–FR–A000", xlPart
.Replace "300", "FSAEM–16–121–FE–0000", xlPart
.Replace "A400", "FSAEM–16–121–EL–A000", xlPart
.Replace "400", "FSAEM–16–121–EL–0000", xlPart
.Replace "A500", "FSAEM–16–121–MS–A000", xlPart
.Replace "500", "FSAEM–16–121–MS–0000", xlPart
.Replace "A600", "FSAEM–16–121–ST–A000", xlPart
.Replace "600", "FSAEM–16–121–ST–0000", xlPart
.Replace "A700", "FSAEM–16–121–SU–A000", xlPart
.Replace "700", "FSAEM–16–121–SU–0000", xlPart
.Replace "A800", "FSAEM–16–121–WT–A000", xlPart
.Replace "800", "FSAEM–16–121–WT–0000", xlPart
End With
End Sub

告诉你它不优雅。部件号始终位于单元格B4中。我如何在VBA中将-AA连接到最后？我找不到任何关于连接代码的信息。（现在这个宏可以完成我需要的所有工作但是替换了-AA。）

除此之外，是否有更优雅的方式来编写它，所以我不需要在最后连接-AA并将它与.replace放在同一行？

Answer 1

尝试以下函数，该函数遍历范围并检查空单元格。根据需要添加案例陈述。有更好的解决方案，但这很快。

Sub test()

    ReplaceText (ActiveSheet.Columns("B:B").Cells)

End Sub

Function ReplaceText(rng As Range)
    Dim r As Range
    For Each r In rng
        If IsEmpty(r.Value) = False Then
            'r.Value = Replace(r.Value, "as", "bm") & "-AA"
            Select Case r.Value
                Case "A100"
                    r.Value = Replace(r.Value, "A100", "FSAEM–16–121–BR–A000")
                Case "A200"
                    r.Value = Replace(r.Value, "A200", "FSAEM–16–121–EN–A000")
            End Select
            r.Value = r.Value & "-AA"
        End If
    Next
End Function

Answer 2

使用正则表达式可能是您唯一的选择，因为您正在搜索部分匹配并使用合成。

以下是使用已定义的模板替换B列中的所有匹配值的示例：

' load the data from column B
Dim rg_data As Range, data(), template$, r&
Set rg_data = Intersect(ActiveSheet.Columns("B"), ActiveSheet.UsedRange)
data = rg_data.Value2

' define the pattern to match the targeted values
Const MATCH_PATTERN = "(A?[1-8])(00.)"

' define the replacement templates (key = first group, $2 = second group)
Dim tpls As New collection
tpls.Add "FSAEM–16–121–BR–A0$2-AA", "A1"
tpls.Add "FSAEM–16–121–BR–00$2-AA", "1"
tpls.Add "FSAEM–16–121–EN–A0$2-AA", "A2"
tpls.Add "FSAEM–16–121–EN–00$2-AA", "2"
tpls.Add "FSAEM–16–121–FR–A0$2-AA", "A3"
tpls.Add "FSAEM–16–121–FE–00$2-AA", "3"
tpls.Add "FSAEM–16–121–EL–A0$2-AA", "A4"
tpls.Add "FSAEM–16–121–EL–00$2-AA", "4"
tpls.Add "FSAEM–16–121–MS–A0$2-AA", "A5"
tpls.Add "FSAEM–16–121–MS–00$2-AA", "5"
tpls.Add "FSAEM–16–121–ST–A0$2-AA", "A6"
tpls.Add "FSAEM–16–121–ST–00$2-AA", "6"
tpls.Add "FSAEM–16–121–SU–A0$2-AA", "A7"
tpls.Add "FSAEM–16–121–SU–00$2-AA", "7"
tpls.Add "FSAEM–16–121–WT–A0$2-AA", "A8"
tpls.Add "FSAEM–16–121–WT–00$2-AA", "8"

' create the regex object
Dim re As Object, match As Object
Set re = CreateObject("VBScript.RegExp")
re.pattern = MATCH_PATTERN

' replace all the values
For r = 1 To UBound(data)
  Set match = re.Execute(data(r, 1))
  If match.count Then  ' if found
    template = tpls(match(0).SubMatches(0))
    data(r, 1) = re.Replace(data(r, 1), template)
  End If
Next

' copy the data back to the sheet
rg_data.Value2 = data

在Excel VBA中连接单个单元格

2 个答案: