Страницы: 1
RSS
Отделение буквенно-цифрового артикула от Наименования
 
Здравствуйте. На форуме есть похожие темы, но не нашел применимую к моему случаю (если такая есть - пошлите туда).
Задача такая: наименование товара идет в одной ячейке с артикулом (сначала артикул, а затем наименование), нужно отделить его в отдельную ячейку.
Сложность в том, что артикул содержит пробелы и может заканчиваться на буквы.
Букв в конце может быть максимум две, поэтому, на мой взгляд, идея такая: нужно отделять все от левого края и до тех пор, пока не будет три буквы подряд.
На примере ячейка выглядит так:
1123 25148 358 ПА Вентиль.                      
Наименование "Вентиль", все остальное - артикул.
Возможно ли это сделать средствами экселя?
Спасибо.

Дополню: количество символов в артикуле может быть разным.
Изменено: dmitriwhite - 13.10.2017 15:19:30
 
Цитата
mitriwhite написал:
Возможно ли это сделать средствами экселя?
Наверно возможно , но без файла примера, нельзя что-то сказать однозначно. Только по 1 примеру судить сложно.
"Все гениальное просто, а все простое гениально!!!"
 
Вот пример
 
И как посторонний человек поймет, где кончается артикул и начинается наименование? А ведь это еще нужно программе объяснить?
например:
Цитата
3307 ИП-110 у Ключ балонный
Похоже, что "у" - часть артикула... Название всегда начинается с заглавной буквы? Хорошо.. берем следующий пример:
Цитата
291156 П29 Болт
П29 - часть артикула, но с заглавной!
 
Если Ваша строка записана в ячейке B1, то в ячейку G1 можно записать следующую {формулу массива} (вместо ENTER => CTRL+SHFT+ENTER):
Код
=ПОИСКПОЗ(1;(КОДСИМВ(ПСТР($B$1;СТРОКА($A$1:$A$30)-1;1))>64)*(КОДСИМВ(ПСТР($B$1;СТРОКА($A$1:$A$30);1))>64)*(КОДСИМВ(ПСТР($B$1;СТРОКА($A$1:$A$30)+1;1))>64);0)
и она вернет Вам значение 20, соответствующее первому вхождению трех буквенных знаков подряд.
Тогда с помощью данного вспомогательного вычисления Вы сможете разделить текст на артикул и наименование в новых ячейках:
Код
=ЛЕВСИМВ(B1;G1-3)
=ПРАВСИМВ(B1;2+ДЛСТР(B1)-G1)
Если у Вас встречаются строки длиннее 30 символов, то диапазон СТРОКА($A$1:$A$30) придется расширить...
 
я бы традиционно предложил udf :)
Код
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
 
ещё вариант функции в столбце C
 
Код
Function uuu(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = "[а-яё]{3,}": .IgnoreCase = True
  uuu = .Execute(t)(0)
  End With
End Function
Код
Function vvv(t$)
  With CreateObject("VBScript.RegExp")
  .Pattern = "^.+(?=" & uuu(t) & ")": vvv = .Execute(t)(0)
 End With
End Function
Изменено: sv2013 - 13.10.2017 23:18:49
 
webley, sv2013, Благодарю за помощь

webley, sv2013 возможно ли в ваших функциях сделать так, чтобы артикул не копировался, а вырезался?  

Оба варианта работаю отлично
Изменено: dmitriwhite - 16.10.2017 09:56:46
 
вариант макроса,соответствующего функции 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
Изменено: sv2013 - 16.10.2017 10:08:49
 
Благодарю
Страницы: 1
Наверх