連接Excel VBA中的單個單元格

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