Задача-разбить ячейки с каталожными номерами, чтобы в каждой ячейке было по одному номеру Помогите пожалуйста решить ситуацию: В ячейке сразу несколько каталожных номеров. При этом некоторые состоят только из второй части номера. Необходимо сделать чтобы каждый номер был отдельно, в следующей колонке
выделить диапазон (в нём должен быть ТОЛЬКО ОДИН столбец), выполнить макрос, справа будет результат
Код
Sub jjj()
If Selection.Columns.CountLarge > 1 Then Exit Sub
Dim rngSrc As Range: Set rngSrc = Selection.Resize(, 2)
Dim arrSrc(): arrSrc = rngSrc.Value
Dim arrResult(): ReDim arrResult(1 To UBound(arrSrc), 1 To 1)
Dim i As Long
Dim j As Long
Dim sPartSN As String
For i = 1 To UBound(arrSrc)
arrResult(i, 1) = Split(arrSrc(i, 1), vbLf)
For j = 1 To UBound(arrResult(i, 1))
sPartSN = Split(arrResult(i, 1)(j - 1), "-")(0)
arrResult(i, 1)(j) = WorksheetFunction.Trim(arrResult(i, 1)(j))
If StrComp(Left$(arrResult(i, 1)(j), 1), "-") = 0 Then
arrResult(i, 1)(j) = sPartSN & arrResult(i, 1)(j)
End If
Next j
rngSrc.Cells(i, 1).Offset(, 1).Resize(1, UBound(arrResult(i, 1)) + 1).Value = arrResult(i, 1)
Next i
End Sub