Здравствуйте. На форуме есть похожие темы, но не нашел применимую к моему случаю (если такая есть - пошлите туда). Задача такая: наименование товара идет в одной ячейке с артикулом (сначала артикул, а затем наименование), нужно отделить его в отдельную ячейку. Сложность в том, что артикул содержит пробелы и может заканчиваться на буквы. Букв в конце может быть максимум две, поэтому, на мой взгляд, идея такая: нужно отделять все от левого края и до тех пор, пока не будет три буквы подряд. На примере ячейка выглядит так: 1123 25148 358 ПА Вентиль. Наименование "Вентиль", все остальное - артикул. Возможно ли это сделать средствами экселя? Спасибо.
Дополню: количество символов в артикуле может быть разным.
и она вернет Вам значение 20, соответствующее первому вхождению трех буквенных знаков подряд. Тогда с помощью данного вспомогательного вычисления Вы сможете разделить текст на артикул и наименование в новых ячейках:
Код
=ЛЕВСИМВ(B1;G1-3)
=ПРАВСИМВ(B1;2+ДЛСТР(B1)-G1)
Если у Вас встречаются строки длиннее 30 символов, то диапазон СТРОКА($A$1:$A$30) придется расширить...
Public Function Art(InSt As String, p As Integer) As String
Dim j As Integer, k As Integer
For j = 1 To Len(InSt) - 3
k = 0
If Mid(InSt, j, 1) = " " And IsLetter(Mid(InSt, j + 1, 1)) And IsLetter(Mid(InSt, j + 2, 1)) And IsLetter(Mid(InSt, j + 3, 1)) Then
k = j
Exit For
End If
Next j
If k = 0 Then
If p = 1 Then Art = ""
If p = 2 Then Art = InSt
Else
If p = 1 Then Art = Left(InSt, j - 1)
If p = 2 Then Art = Right(InSt, Len(InSt) - j)
End If
End Function
Public Function IsLetter(s As String) As Boolean
If Asc(s) >= 192 And Asc(s) <= 255 Then
IsLetter = True
ElseIf Asc(s) >= 65 And Asc(s) <= 90 Then
IsLetter = True
ElseIf Asc(s) >= 97 And Asc(s) <= 122 Then
IsLetter = True
Else
IsLetter = False
End If
End Function
вариант макроса,соответствующего функции vvv,кнопки test и повтор,лист Лист3 вспомогательный для демонстрации повтора.
Код
Sub test1()
Dim z, t$, t1$, i&: z = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Value
With CreateObject("VBScript.RegExp"): .IgnoreCase = True
For i = 1 To UBound(z): t = z(i, 1): t1 = uuu(t): .Pattern = "^.+(?=" & t1 & ")"
z(i, 1) = .Replace(t, "")
Next
Range("B1").Resize(UBound(z), 1).Value = z
End With
End Sub
Код
Function uuu(t$)
With CreateObject("VBScript.RegExp"): .Pattern = "[а-яё]{3,}": .IgnoreCase = True
uuu = .Execute(t)(0)
End With
End Function