Доброе время. Есть ячйки с текстом, в тексте есть IP адрес. Задача вытащить только IP адрес и прописать в соседней ячейке. пробовал через ПСТР, но проблема в разной длинне адресов и копируется ненужная информация, через ПОИСК и НАЙТИ не смог. Просьба помочь макросом
Доброе время. Есть ячйки с текстом, в тексте есть IP адрес. Задача вытащить только IP адрес и прописать в соседней ячейке. пробовал через ПСТР, но проблема в разной длинне адресов и копируется ненужная информация, через ПОИСК и НАЙТИ не смог. Просьба помочь макросомmegafox
Function ExcecuteIP$(strText$) Application.Volatile Dim obj As Object With CreateObject("VBScript.Regexp") .Pattern = "\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}" Set obj = .Execute(strText) If obj.Count > 0 Then ExcecuteIP = obj.Item(0) Else ExcecuteIP = "" End With End Function
[/vba] IP на корректность не проверял, ибо пример бы её не прошёл B) UPD не проснулся ещё, так проще: [vba]
Код
Function ExcecuteIP$(strText$) Application.Volatile With CreateObject("VBScript.Regexp") .Pattern = "(\d{1,3}\.){3}\d{1,3}" If .test(strText) Then ExcecuteIP = .Execute(strText)(0) Else ExcecuteIP = "" End With End Function
[/vba]
UDF-ка [vba]
Код
Function ExcecuteIP$(strText$) Application.Volatile Dim obj As Object With CreateObject("VBScript.Regexp") .Pattern = "\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}" Set obj = .Execute(strText) If obj.Count > 0 Then ExcecuteIP = obj.Item(0) Else ExcecuteIP = "" End With End Function
[/vba] IP на корректность не проверял, ибо пример бы её не прошёл B) UPD не проснулся ещё, так проще: [vba]
Код
Function ExcecuteIP$(strText$) Application.Volatile With CreateObject("VBScript.Regexp") .Pattern = "(\d{1,3}\.){3}\d{1,3}" If .test(strText) Then ExcecuteIP = .Execute(strText)(0) Else ExcecuteIP = "" End With End Function
megafox, добрый день,еще вариант функции uuu в столбце C или yyy без регулярок
[vba]
Код
Function yyy$(t$) Dim i% For i = 1 To Len(t) If IsNumeric(Mid(t, i, 1)) Or Mid(t, i, 1) = "." Then yyy = yyy & Mid(t, i, 1) End If Next End Function
[/vba]
[vba]
Код
Function uuu$(t$) With CreateObject("VBScript.Regexp") .Pattern = "[а-яё\s]+": .Global = True If .test(t) Then uuu = .Replace(t, "") Else uuu = "" End With End Function
[/vba]
megafox, добрый день,еще вариант функции uuu в столбце C или yyy без регулярок
[vba]
Код
Function yyy$(t$) Dim i% For i = 1 To Len(t) If IsNumeric(Mid(t, i, 1)) Or Mid(t, i, 1) = "." Then yyy = yyy & Mid(t, i, 1) End If Next End Function
[/vba]
[vba]
Код
Function uuu$(t$) With CreateObject("VBScript.Regexp") .Pattern = "[а-яё\s]+": .Global = True If .test(t) Then uuu = .Replace(t, "") Else uuu = "" End With End Function