Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Извлечение из целого текста значения в заданную колонку по паттерну
 
#1
26.12.2019 20:35:49
Добрый вечер.
Прошу вашей помощи.
---
Есть цельный текст такого вида в ячейке.
Высота, в см 48,6 Ширина, в см 31,8 Глубина, в см 30,6 Вес, в кг 8
Ширина, в см 6 Высота, в см 9 Глубина, в см 3 Вес, в граммах 520

Как в выделенном диапазоне совершить поиск по паттерну, и перенести это значение в заданную колонку

Вес, в кг ([\d\,]+)
Высота, в см ([\d\,]+)

И что бы не создавать новую тему  в примере есть строка у которой я не могу удалить символ похожий на пробел
Пробовал удалить его как символ табуляции Chr(9) но он не удаляется
 
 
 
#2
26.12.2019 20:56:47
Символ, похожий на пробел, но не пробел, в Word обзывается неразрывный пробел, и имеет код символа 160.
 
 
 
#3
26.12.2019 20:57:57
Цитата
DartoArem написал:
Пробовал удалить его как символ табуляции Chr(9) но он не удаляется
не нашел вашего символа; попробуйте Chr(160)
 
 
 
#4
26.12.2019 20:59:57
Selection.Replace what:="Chr(160)", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Пробовал так, не удаляется
 
 
 
#5
26.12.2019 21:02:11
А так?
Код
what:=Chr(160)
 
 
 
#6
26.12.2019 21:06:05
Не помогло
 
 
 
#7
26.12.2019 21:07:59
Вес
UDF
Код
Function iWeight(cell$)
 With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = "(Вес, в кг |Вес, в граммах )(\d+,?(\d*))"
     iWeight = .Execute(cell)(0).SubMatches(1)
 End With
End Function
 
 
 
#8
26.12.2019 21:11:25
Kuzmich, Спасибо.
Но можно в виде макроса, я не уверен что смогу UDF переделать
 
 
 
#9
26.12.2019 21:27:52
Код
Sub Tablica()
Dim i As Long
Dim iLastRow As Long
 iLastRow = Range("A3").End(xlDown).Row
 With CreateObject("VBScript.RegExp")
   .Global = True
  For i = 3 To iLastRow
     .Pattern = "(Вес, в кг |Вес, в граммах )(\d+,?(\d*))"
     Cells(i, "B") = CDbl(.Execute(Cells(i, "A"))(0).SubMatches(1))
     .Pattern = "(Высота, в см )(\d+,?(\d*))"
     Cells(i, "C") = CDbl(.Execute(Cells(i, "A"))(0).SubMatches(1))
     .Pattern = "(Ширина, в см )(\d+,?(\d*))"
     Cells(i, "D") = CDbl(.Execute(Cells(i, "A"))(0).SubMatches(1))
     .Pattern = "(Глубина, в см )(\d+,?(\d*))"
     If .test(Cells(i, "A")) Then
       Cells(i, "E") = CDbl(.Execute(Cells(i, "A"))(0).SubMatches(1))
     End If
  Next
 End With
End Sub
 
 
 
#10
26.12.2019 21:57:52
Kuzmich,
огромное спасибо за макрос
Хочу еще спросить, можно сантиметры при переносе сразу перевести в миллиметры?
 
 
 
#11
26.12.2019 22:06:16
Цитата
можно сантиметры при переносе сразу перевести в миллиметры?
Можно. Умножьте на 10
 
 
 
#12
27.12.2019 20:44:19
По поводу символа табуляции который не хочет удалятся.
Код
Selection.Replace what:="Chr(9)", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Если пробовать удалить так, то он зараза не удаляется.

Код
For Each cc In Selection.Cells
cc.Value = Replace(cc.Value, Chr(9), "")
Next
А если так, то удаляется
Изменено: DartoArem - 27.12.2019 20:45:23
 
 
 
Страницы: 1
Наверх