在Excel VBA中连接单个单元格

所以我正在写一个macros来把一个零件号码从一个简单的零件号码变成一个扩展的零件号码。 我的代码现在不是优雅的，但它的工作。

说我有一个零件编号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中。 我将如何将-AA连接到VBA的最后？ 我无法find任何关于连接代码的信息。 （现在这个macros做我需要的一切，但是replace-AA）。

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

Answer 1

尝试下面的函数，循环遍历范围并检查空单元格。 根据需要添加case语句。 有更好的解决scheme，但这很快。

 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

使用正则expression式可能是您唯一的select，因为您正在search部分匹配和使用合成。

这里是一个例子，用定义的模板replace列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