Страницы: 1
RSS
Делим текст на куски по первой попавшейся букве кирилицы
 
Доброго времени суток!  
На сайте в приемах есть статья "Делим текст на куски". Данная пользовательская функция делит текст по указанным пользователем символам разделения: , . - _ и т.д.  
К моему случаю не подойдет, т.к. пробелы присутствуют и в артикулах:  
1U6807423B 01C Молдинг      'перед 01C один пробел  
3T0857537  GRU Корпус       'перед GRU два пробела  
115940155 Клапан            'здесь расширение отсутствует  
...  
В наименовании все слова на кирилице (Молдинг), а артикул на латинице(1U6807423B 01C).  
Подскажите пожалуйста как сделать деление артикула и наименования по разным столбцам.  
Заранее спасибо.
 
как-то так...
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
для кода можно еще так (формула массива):  
=ЛЕВСИМВ(A1;ПОИСКПОЗ(ИСТИНА;ПСТР(A1&"А";СТРОКА(A$1:A$99);1)>="А";)-1)  
 
А название так (массивный ввод не требуется):  
=ПРОСМОТР(2;1/(ПРАВСИМВ(A1&"А";СТРОКА(A$1:A$99))>="А");ПРАВСИМВ(A1;СТРОКА(A$1:A$99)-1))
 
Спасибо огромное.  
Надо будет часто работать с этим, поэтому хотелось сделать пользовательскую функцию.
 
А зачем делать пользовательскую функцию, если её в готовом виде можно найти в интернете?   
http://excelvba.ru/code/SplitLanguages
 
Не подходит, т.к. выдергивает из 1U6807423B 01C в англ часть UBC, а в русскую  
1680742301.  
Что нужно добавить вместо "Delimiter" ("n" - можно убрать)  
Function Substring(Txt, Delimiter, n) As String  
  Dim x As Variant  
     x = Split(Txt, Delimiter)  
     If n > 0 And n - 1 <= UBound(x) Then  
       Substring = x(n - 1)  
     Else  
       Substring = ""  
     End If  
End Function
 
вариант(ы) с UDF
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Спасибо большое за помощь, воспользовался вариантом предложенным ikki.  
Получилось так:  
Function Rus%(s$)  
 Dim i%  
 For i = 1 To Len(s)  
   If Mid(s, i, 1) Like "[А-Яа-яЁё]" Then Rus = i: Exit Function
 Next  
End Function  
 
Sub skynano()  
Application.ScreenUpdating = False  
Columns(1).NumberFormat = "@"  
   llLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count  
   For ll = llLastRow To 1 Step -1  
   If Cells(ll, 1) <> "" Then _  
   Cells(ll, 30) = Cells(ll, 1): Cells(ll, 1) = Left(Cells(ll, 30), Rus(Cells(ll, 30)) - 2): _  
   Cells(ll, 2) = Mid(Cells(ll, 30), Rus(Cells(ll, 30)), Len(Cells(ll, 30)))  
   Next ll  
   llLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count  
   For li = llLastRow To 1 Step -1  
   If Application.CountA(Rows(li)) = 0 Then Rows(li).Delete  
   If Cells(li, 1) <> "" Then _  
   Cells(li, 30) = ""  
   Next li  
End Sub
Страницы: 1
Читают тему
Наверх
Loading...