Найти и заменить несколькими значениями для каждого вхождения (VBA)

Question

У меня есть SKU, которые нужно конвертировать несколько раз в зависимости от количества штук. Например Исходные данные:

• BRP-100_cn_3pc_16x20

желаемый результат:

• BRP-100a_cn_16x20

• BRP-100b_cn_16x20

• BRP-100c_cn_16x20

каждая в отдельной ячейке в том же столбце (примечание 3pc = a, b, c для других SKU 4pc = a, b, c, d… и т. Д.) Данные копируются из сводной таблицы и вставляются на другой лист. Я записал макрос и добавил оператор For Each. Он работает только для первого экземпляра, а не для всех вставленных SKU.

Заранее спасибо

Sub ReplaceEach()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual

Dim myrange As range
Set myrange = Sheets("PT_Data").range("K" & Rows.count).End(xlUp)
Dim i As Variant

Columns("K:K").Select

For Each i In myrange

Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="a_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="b_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="c_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="d_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="e_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="f_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="g_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="h_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Selection.Find(What:="_cn_9pc_12x12", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Replace What:="_cn_9pc_12x12", Replacement:="i_cn_12x12", _
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat _
    :=False, ReplaceFormat:=False
Next i

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic

End Sub

Answer 1

Вы можете использовать что-то вроде этого:

Sub ExpandAll()
    Dim c As Range, arr
    'loop over the input values
    For Each c In ActiveSheet.Range("B3:B8").Cells
        arr = ExpandSKU(c.Value) '<< expand this SKU
        'adjust destination to suit...
        ActiveSheet.Cells(Rows.Count, 4).End(xlUp). _
              Offset(1, 0).Resize(UBound(arr, 1), 1).Value = arr
        c.Value = "" 'clear the original
    Next c
End Sub



Function ExpandSKU(sku)
    Dim arrSku, arrOut(), num, i As Long
    arrSku = Split(sku, "_")

    num = Replace(arrSku(2), "pc", "")
    ReDim arrOut(1 To num, 1 To 1)
    For i = 1 To num
        arrOut(i, 1) = Join(Array(arrSku(0) & Chr(96 + i), _
                                  arrSku(1), arrSku(3)), "_")
    Next i

    ExpandSKU = arrOut
End Function