В таблице надо вводить номера IP в локальной сети. Не могу додуматься, какой формат ячейки создать что бы при вводе: 192168001002 в ячейке писалось бы 192.168.1.2. И ячейки должны сортироваться по возрастанию и убыванию. P.S. честно говоря не знаю азов в EXEL. Знания отрывочные из того, что найду в Internet`e. Всё, что нахожу на Этом сайте складываю в каталоги и по возможности использую. Иногда поняв, как работает изменяю. Заранее спасибо.
В таблице надо вводить номера IP в локальной сети. Не могу додуматься, какой формат ячейки создать что бы при вводе: 192168001002 в ячейке писалось бы 192.168.1.2. И ячейки должны сортироваться по возрастанию и убыванию. P.S. честно говоря не знаю азов в EXEL. Знания отрывочные из того, что найду в Internet`e. Всё, что нахожу на Этом сайте складываю в каталоги и по возможности использую. Иногда поняв, как работает изменяю. Заранее спасибо.DrMini
Не вставлял проверку на валидность адреса, сделал только разбивку. Проверяйте [vba]
Код
Function GetIp(Text As String) As String With CreateObject("VBScript.RegExp") .Global = True .Pattern = "(\d{3})(\d{3})(\d{1,3})(\d{1,3})" GetIp = .Replace(Text, "$1.$2.$3.$4") .Pattern = "(?:\.|^)0+" GetIp = .Replace(GetIp, ".") End With End Function
[/vba] UPD так с проверкой павильности [vba]
Код
Function GetIp(Text As String) As String Dim arr, I As Integer With CreateObject("VBScript.RegExp") .Global = True .Pattern = "(\d{3})(\d{3})(\d{1,3})(\d{1,3})" Text = .Replace(Text, "$1.$2.$3.$4") If Text = "" Then Exit Function arr = Split(Text, ".") For I = 0 To UBound(arr) arr(I) = Val(arr(I)) If arr(I) > 255 Then Exit Function Next GetIp = Join(arr, ".") End With End Function
[/vba]
Не вставлял проверку на валидность адреса, сделал только разбивку. Проверяйте [vba]
Код
Function GetIp(Text As String) As String With CreateObject("VBScript.RegExp") .Global = True .Pattern = "(\d{3})(\d{3})(\d{1,3})(\d{1,3})" GetIp = .Replace(Text, "$1.$2.$3.$4") .Pattern = "(?:\.|^)0+" GetIp = .Replace(GetIp, ".") End With End Function
[/vba] UPD так с проверкой павильности [vba]
Код
Function GetIp(Text As String) As String Dim arr, I As Integer With CreateObject("VBScript.RegExp") .Global = True .Pattern = "(\d{3})(\d{3})(\d{1,3})(\d{1,3})" Text = .Replace(Text, "$1.$2.$3.$4") If Text = "" Then Exit Function arr = Split(Text, ".") For I = 0 To UBound(arr) arr(I) = Val(arr(I)) If arr(I) > 255 Then Exit Function Next GetIp = Join(arr, ".") End With End Function
МВТ, Спасибо. Последний макрос прелесть. Только мне надо, что бы в какую ячейку я вношу данные в той же они и правились. Получается циклическая ссылка. Но всё равно СПАСИБО БОЛЬШОЕ.
МВТ, Спасибо. Последний макрос прелесть. Только мне надо, что бы в какую ячейку я вношу данные в той же они и правились. Получается циклическая ссылка. Но всё равно СПАСИБО БОЛЬШОЕ.DrMini
МВТ, Проверил и первый макрос. Если вводишь первую часть IP до 100 - то выдаёт точку перед IP адресом. Пример: 010090090091 выдаёт .10.90.90.91 Дорабатывать не надо. Просто может Вам пригодится. Ещё раз спасибо за Ваш труд.
МВТ, Проверил и первый макрос. Если вводишь первую часть IP до 100 - то выдаёт точку перед IP адресом. Пример: 010090090091 выдаёт .10.90.90.91 Дорабатывать не надо. Просто может Вам пригодится. Ещё раз спасибо за Ваш труд.DrMini
DrMini, Вам же не предлагают функцию GetIP прямо в ячейки для ввода IP пихать, это и не получится. Сделайте свой простенький макрос-процедуру (Sub) на основе вызова данной функции.
DrMini, Вам же не предлагают функцию GetIP прямо в ячейки для ввода IP пихать, это и не получится. Сделайте свой простенький макрос-процедуру (Sub) на основе вызова данной функции.abtextime
Сделайте свой простенький макрос-процедуру (Sub) на основе вызова данной функции.
Извиняюсь. Но я в этом не силён. Пока только простейшие формулы и форматы ячейки пытаюсь выучить. С 1996 года собирал компьютеры и ставил Windows. А тут полгода назад попробовал и затянуло. Рядом спросить некого. Ладно есть ЭТОТ сайт. Сейчас поищу в поисковике может получится. За пояснение спасибо.
abtextime,
Цитата
Сделайте свой простенький макрос-процедуру (Sub) на основе вызова данной функции.
Извиняюсь. Но я в этом не силён. Пока только простейшие формулы и форматы ячейки пытаюсь выучить. С 1996 года собирал компьютеры и ставил Windows. А тут полгода назад попробовал и затянуло. Рядом спросить некого. Ладно есть ЭТОТ сайт. Сейчас поищу в поисковике может получится. За пояснение спасибо.DrMini
Сообщение отредактировал DrMini - Пятница, 11.03.2016, 16:35
Есть еще одна проблема: если 3-я и/или 4-я часть адреса введена меньше, чем из 3- цифр, то максимальный кусок будет засчитан 3-й части. Например, 1921682123 будет интерпретировано как 192.168.212.3, а не как, например 192.168.21.23. Но здесь ничего не поделать, откуда алгоритму знать, что мы имели в виду ?
Есть еще одна проблема: если 3-я и/или 4-я часть адреса введена меньше, чем из 3- цифр, то максимальный кусок будет засчитан 3-й части. Например, 1921682123 будет интерпретировано как 192.168.212.3, а не как, например 192.168.21.23. Но здесь ничего не поделать, откуда алгоритму знать, что мы имели в виду ?МВТ
Сделайте свой простенький макрос-процедуру (Sub) на основе вызова данной функции.
Покажите пожалуйста на моём примере, как это сделать. Три дня в свободное время копался в Internet`e - так и не осилил. P.S. для этой таблицы это не нужно. Но. ОЧЕНЬ заинтересовало. Спасибо за любой ответ.
abtextime,
Цитата
Сделайте свой простенький макрос-процедуру (Sub) на основе вызова данной функции.
Покажите пожалуйста на моём примере, как это сделать. Три дня в свободное время копался в Internet`e - так и не осилил. P.S. для этой таблицы это не нужно. Но. ОЧЕНЬ заинтересовало. Спасибо за любой ответ.DrMini
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not IsNumeric(Target) Then Exit Sub If Len(Target) <> 12 Then Exit Sub n_ = Format(Target, "000\.000\.000\.000") Target = Replace(Replace(n_, ".00", "."), ".0", ".") End Sub
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not IsNumeric(Target) Then Exit Sub If Len(Target) <> 12 Then Exit Sub n_ = Format(Target, "000\.000\.000\.000") Target = Replace(Replace(n_, ".00", "."), ".0", ".") End Sub
Вот такой код, если вставить его в модуль листа, будет автоматически заменять введенное 12-тизначное число на IP адрес или на значение присваиваемое константе ErrMsg (можете заменить его, например на "Ошибка!!!") Диапазон, в котором идет проверка задается константой RngAddress. [vba]
Код
Const RngAddress = "A1:A10" Const ErrMsg = "" Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range(RngAddress)) Is Nothing Then Exit Sub Application.EnableEvents = False With Target If .Value Like "############" Then Dim arr(0 To 3), I As Integer, S As String For I = 1 To 4 S = Mid(.Value, 1 + (I - 1) * 3, 3) arr(I - 1) = Val(S) If arr(I - 1) > 255 Then .Value = ErrMsg Application.EnableEvents = True Exit Sub End If Next .Value = Join(arr, ".") Else .Value = ErrMsg End If Application.EnableEvents = True End With End Sub
[/vba]
Вот такой код, если вставить его в модуль листа, будет автоматически заменять введенное 12-тизначное число на IP адрес или на значение присваиваемое константе ErrMsg (можете заменить его, например на "Ошибка!!!") Диапазон, в котором идет проверка задается константой RngAddress. [vba]
Код
Const RngAddress = "A1:A10" Const ErrMsg = "" Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range(RngAddress)) Is Nothing Then Exit Sub Application.EnableEvents = False With Target If .Value Like "############" Then Dim arr(0 To 3), I As Integer, S As String For I = 1 To 4 S = Mid(.Value, 1 + (I - 1) * 3, 3) arr(I - 1) = Val(S) If arr(I - 1) > 255 Then .Value = ErrMsg Application.EnableEvents = True Exit Sub End If Next .Value = Join(arr, ".") Else .Value = ErrMsg End If Application.EnableEvents = True End With End Sub
_Boroda_, СПАСИБО за ответ. Как я и говорил формулы мне не пригодятся в этой таблице, но в свою "коллекцию" сохранил. Процедура (Sub) работает на всём листе.
_Boroda_, СПАСИБО за ответ. Как я и говорил формулы мне не пригодятся в этой таблице, но в свою "коллекцию" сохранил. Процедура (Sub) работает на всём листе. DrMini
С учетом более простых проверок, взятых из кода Александра (что-то я немножко перемудрил), можно сделать так [vba]
Код
Const RngAddress = "A1:A10" Const ErrMsg = ""
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range(RngAddress)) Is Nothing Then Exit Sub Application.EnableEvents = False With Target If IsNumeric(.Value) And Len(.Value) = 12 Then Dim arr, I As Integer arr = Split(Format(.Value, "000\.000\.000\.000"), ".") For I = 0 To 3 arr(I) = Val(arr(I)) If arr(I) > 255 Then .Value = ErrMsg GoTo 1 End If Next S = Join(arr, ".") Else .Value = ErrMsg GoTo 1 End If .Value = S 1: Application.EnableEvents = True End With End Sub
[/vba]
С учетом более простых проверок, взятых из кода Александра (что-то я немножко перемудрил), можно сделать так [vba]
Код
Const RngAddress = "A1:A10" Const ErrMsg = ""
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range(RngAddress)) Is Nothing Then Exit Sub Application.EnableEvents = False With Target If IsNumeric(.Value) And Len(.Value) = 12 Then Dim arr, I As Integer arr = Split(Format(.Value, "000\.000\.000\.000"), ".") For I = 0 To 3 arr(I) = Val(arr(I)) If arr(I) > 255 Then .Value = ErrMsg GoTo 1 End If Next S = Join(arr, ".") Else .Value = ErrMsg GoTo 1 End If .Value = S 1: Application.EnableEvents = True End With End Sub