Добрый день, уважаемые форумчане! Хочу обратиться к вам за помощью. Не знаю, в том ли разделе размещаю вопрос, но тем не менее.
Итак, есть диапазон ячеек, содержащих развернутые текстовые описания продукции. Это выгрузка из таможенной базы, поэтому текст каждой ячейки уникален. Но встречаются одинаковые части. В частности, в каждой имеется указание на количество поставленной продукции. Это выглядит так: 1 шт либо кол-во - 1шт, колво 1шт. Т.е. написание может быть различным. Мне необходимо извлечь как раз данные о количестве из каждой из ячеек. Можно ли как-то привязаться к слову "колво" или "шт"? Заранее благодарна за советы!
Добрый день, уважаемые форумчане! Хочу обратиться к вам за помощью. Не знаю, в том ли разделе размещаю вопрос, но тем не менее.
Итак, есть диапазон ячеек, содержащих развернутые текстовые описания продукции. Это выгрузка из таможенной базы, поэтому текст каждой ячейки уникален. Но встречаются одинаковые части. В частности, в каждой имеется указание на количество поставленной продукции. Это выглядит так: 1 шт либо кол-во - 1шт, колво 1шт. Т.е. написание может быть различным. Мне необходимо извлечь как раз данные о количестве из каждой из ячеек. Можно ли как-то привязаться к слову "колво" или "шт"? Заранее благодарна за советы!Nozomi_yoshi
Вот эта UDF вытягивает количество по номеру вхождения, но без привязки к названию товара[vba]
Код
Option Explicit Function Cnt(Text As String, Number As Long) Dim Obj As Object With CreateObject("VBScript.RegExp") .Global = True .Ignorecase = True .Pattern = "(\d+)(?= *?шт)" If .test(Text) Then Set Obj = .Execute(Text) If Number <= Obj.Count Then Cnt = Obj(Number - 1).Submatches(0) End If End With End Function
[/vba]
Вот эта UDF вытягивает количество по номеру вхождения, но без привязки к названию товара[vba]
Код
Option Explicit Function Cnt(Text As String, Number As Long) Dim Obj As Object With CreateObject("VBScript.RegExp") .Global = True .Ignorecase = True .Pattern = "(\d+)(?= *?шт)" If .test(Text) Then Set Obj = .Execute(Text) If Number <= Obj.Count Then Cnt = Obj(Number - 1).Submatches(0) End If End With End Function
МВТ, спасибо! Вставила, начала крутить, но пока не получается При выводе этой функции в поле text ставим номер соответствующей ячейки, а что в поле Number? Если номер вхождения, то ведь сложность в том, что в каждой ячейке искомое значение стоит в разном месте. В любом случае пока, что бы не подставляла в поле Number, формула не срабатывает. Может я что-то не так сделала при вставке UDF? Я впервые это делала. Не покажете на примере ячеек в файле из моего первого сообщения?
МВТ, спасибо! Вставила, начала крутить, но пока не получается При выводе этой функции в поле text ставим номер соответствующей ячейки, а что в поле Number? Если номер вхождения, то ведь сложность в том, что в каждой ячейке искомое значение стоит в разном месте. В любом случае пока, что бы не подставляла в поле Number, формула не срабатывает. Может я что-то не так сделала при вставке UDF? Я впервые это делала. Не покажете на примере ячеек в файле из моего первого сообщения?Nozomi_yoshi
Сообщение отредактировал Nozomi_yoshi - Суббота, 31.10.2015, 17:46
Nozomi_yoshi, добрый день, протестируйте макрос , в файл-примере кнопки,test и очистить
[vba]
Код
Sub test() Dim objMatch As Object, j%, i%, i1% i1 = Range("B" & Cells.Rows.Count).End(xlUp).Row With CreateObject("VBScript.RegExp"): .Global = True: .ignoreCase = True .Pattern = "(\d+)(?= *?шт)" For i = 2 To i1 j = 0 If .test(Range("B" & i)) Then For Each objMatch In .Execute(Range("B" & i)) j = j + 1 Range("B" & i).Offset(, j) = objMatch.SubMatches(0) Next End If Next End With End Sub
[/vba]
Nozomi_yoshi, добрый день, протестируйте макрос , в файл-примере кнопки,test и очистить
[vba]
Код
Sub test() Dim objMatch As Object, j%, i%, i1% i1 = Range("B" & Cells.Rows.Count).End(xlUp).Row With CreateObject("VBScript.RegExp"): .Global = True: .ignoreCase = True .Pattern = "(\d+)(?= *?шт)" For i = 2 To i1 j = 0 If .test(Range("B" & i)) Then For Each objMatch In .Execute(Range("B" & i)) j = j + 1 Range("B" & i).Offset(, j) = objMatch.SubMatches(0) Next End If Next End With End Sub
Nozomi_yoshi, в поле Text подставляется текст или ссылка на ячейку, в которой он содержится, а номер вхождения - это как раз Number. Что касается того, что искомые данные стоят на разных местах, то ответ дан согласно того, как Вы сформулировали задачу. Есть какой-то способ привязки, например, по наименованию товара? UPD держите другую. Text - это текст или ссылка на ячейку, где Вы проводите поиск, FindText - наименование оборудования, количество которого Вы ищите, но с учетом того хаоса, что творится у Вас в ячейках, возможны неточности, если Вы будете неточно обозначать оборудование. Пробуйте [vba]
Код
Option Explicit Function Cnt(Text As String, FindText As String) With CreateObject("VBScript.RegExp") .Global = True .Ignorecase = True .Pattern = "(?:" & FindText & ".*?)(\d+)(?= *?шт)" If .test(Text) Then Cnt = .Execute(Text)(0).Submatches(0) End With End Function
[/vba]
Nozomi_yoshi, в поле Text подставляется текст или ссылка на ячейку, в которой он содержится, а номер вхождения - это как раз Number. Что касается того, что искомые данные стоят на разных местах, то ответ дан согласно того, как Вы сформулировали задачу. Есть какой-то способ привязки, например, по наименованию товара? UPD держите другую. Text - это текст или ссылка на ячейку, где Вы проводите поиск, FindText - наименование оборудования, количество которого Вы ищите, но с учетом того хаоса, что творится у Вас в ячейках, возможны неточности, если Вы будете неточно обозначать оборудование. Пробуйте [vba]
Код
Option Explicit Function Cnt(Text As String, FindText As String) With CreateObject("VBScript.RegExp") .Global = True .Ignorecase = True .Pattern = "(?:" & FindText & ".*?)(\d+)(?= *?шт)" If .test(Text) Then Cnt = .Execute(Text)(0).Submatches(0) End With End Function
МВТ, прошу прощения, да, я,видимо, действительно некорректно сформулировала вопрос. Замечательно, что вышеприведенный макрос сработал. Спасибо Вам за совет и потраченное время.
МВТ, прошу прощения, да, я,видимо, действительно некорректно сформулировала вопрос. Замечательно, что вышеприведенный макрос сработал. Спасибо Вам за совет и потраченное время.Nozomi_yoshi
Nozomi_yoshi, добрый вечер,в файл-примере сделал две кнопки для моего макроса и кнопку ,которая заносит функцию от MBT в диапазон переменного размера,используя вспомогательную функцию Number переименовал функцию MBT,добавив к названию 1,иначе макрос не работает.
[vba]
Код
Sub example2() Dim j%, i%, i1% i1 = Range("B" & Cells.Rows.Count).End(xlUp).Row For i = 2 To i1 For j = 1 To Number(Range("B" & i)) Range("B" & i).Offset(, j).Formula = "=Cint1(B" & i & "," & j & ")" Next Next End Sub
[/vba]
[vba]
Код
Function Number%(Text As String) Dim obj As Object With CreateObject("VBScript.RegExp") .Global = True .Ignorecase = True .Pattern = "(\d+)(?= *?øò)" If .test(Text) Then Set obj = .Execute(Text) Number = obj.Count End If End With End Function
[/vba]
[vba]
Код
Function Cint1(Text As String, Number As Long) Dim obj As Object With CreateObject("VBScript.RegExp") .Global = True .Ignorecase = True .Pattern = "(\d+)(?= *?øò)" If .test(Text) Then Set obj = .Execute(Text) If Number <= obj.Count Then Cint1 = obj(Number - 1).Submatches(0) End If End Function
[/vba]
Nozomi_yoshi, добрый вечер,в файл-примере сделал две кнопки для моего макроса и кнопку ,которая заносит функцию от MBT в диапазон переменного размера,используя вспомогательную функцию Number переименовал функцию MBT,добавив к названию 1,иначе макрос не работает.
[vba]
Код
Sub example2() Dim j%, i%, i1% i1 = Range("B" & Cells.Rows.Count).End(xlUp).Row For i = 2 To i1 For j = 1 To Number(Range("B" & i)) Range("B" & i).Offset(, j).Formula = "=Cint1(B" & i & "," & j & ")" Next Next End Sub
[/vba]
[vba]
Код
Function Number%(Text As String) Dim obj As Object With CreateObject("VBScript.RegExp") .Global = True .Ignorecase = True .Pattern = "(\d+)(?= *?øò)" If .test(Text) Then Set obj = .Execute(Text) Number = obj.Count End If End With End Function
[/vba]
[vba]
Код
Function Cint1(Text As String, Number As Long) Dim obj As Object With CreateObject("VBScript.RegExp") .Global = True .Ignorecase = True .Pattern = "(\d+)(?= *?øò)" If .test(Text) Then Set obj = .Execute(Text) If Number <= obj.Count Then Cint1 = obj(Number - 1).Submatches(0) End If End Function
Nozomi_yoshi, добрый вечер,здесь ,на форуме ,практически в каждой теме имеется дилемма:пользоваться макросом или функцией,-кому,что больше подходит,-по-моему очень удобно заносить кнопкой функцию во все ячейки,можно и вручную все делать,попробуйте как удобней. Удачи Вам.
Nozomi_yoshi, добрый вечер,здесь ,на форуме ,практически в каждой теме имеется дилемма:пользоваться макросом или функцией,-кому,что больше подходит,-по-моему очень удобно заносить кнопкой функцию во все ячейки,можно и вручную все делать,попробуйте как удобней. Удачи Вам.sv2014
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
