Доброго времени суток! Хочу сделать телефонную книгу. Есть список телефонов, сотовые разных операторов, стационарные городские, междугородние. Как можно окрасить ячейки в зависимости от сотового оператора, города, страны. Что бы при вводе номера ячейка окрашивалась и отображала: Имя оператора, регион, страна.
Доброго времени суток! Хочу сделать телефонную книгу. Есть список телефонов, сотовые разных операторов, стационарные городские, междугородние. Как можно окрасить ячейки в зависимости от сотового оператора, города, страны. Что бы при вводе номера ячейка окрашивалась и отображала: Имя оператора, регион, страна.Gold_Barsik
Здравствуйте Che79, ! Неее. не то. Мысль такая! например в пустую ячейку с форматом +7" "(#)" "000-00-00 столбца "B" вводим № телефона типа 9007900000 в результате получить +7 (900) 790-00-00 Антарес, Воронежская обл. В зависимости от сотового оператора как бы появляется подложка ячейки с надписью оператора и региона, а ячейка окрашивается в цвет сотового оператора). Хотелось бы приложить всю книгу целиком, но Лист3 весомым оказался (файл потянул на 996 КБ).
Здравствуйте Che79, ! Неее. не то. Мысль такая! например в пустую ячейку с форматом +7" "(#)" "000-00-00 столбца "B" вводим № телефона типа 9007900000 в результате получить +7 (900) 790-00-00 Антарес, Воронежская обл. В зависимости от сотового оператора как бы появляется подложка ячейки с надписью оператора и региона, а ячейка окрашивается в цвет сотового оператора). Хотелось бы приложить всю книгу целиком, но Лист3 весомым оказался (файл потянул на 996 КБ).Gold_Barsik
Тут кому-то кроме уважаемого коллеги Che79 можно "высказаться"?
Если да, то смотрите такой полуфабрикат [vba]
Код
Public Function Оператор(S As String) As String Dim R As Range, Code As String, Phone As Long Set R = Worksheets("коды, операторы, регионы").Range("A3:K104") Code = Left(S, 3) Phone = CLng(Right(S, Len(S) - 3)) For i = 1 To R.Rows.Count If R.Cells(i, 9).Value = Code And R.Cells(i, 10).Value <= Phone And R.Cells(i, 11).Value >= Phone Then Оператор = R.Cells(i, 1) & ", " & R.Cells(i, 2) & " +7(" & Code & ") " & Mid(S, 4, 3) & "-" & Mid(S, 8, 2) & "-" & Mid(S, 10, 2) Exit Function End If Next i End Function
[/vba]
Тут кому-то кроме уважаемого коллеги Che79 можно "высказаться"?
Если да, то смотрите такой полуфабрикат [vba]
Код
Public Function Оператор(S As String) As String Dim R As Range, Code As String, Phone As Long Set R = Worksheets("коды, операторы, регионы").Range("A3:K104") Code = Left(S, 3) Phone = CLng(Right(S, Len(S) - 3)) For i = 1 To R.Rows.Count If R.Cells(i, 9).Value = Code And R.Cells(i, 10).Value <= Phone And R.Cells(i, 11).Value >= Phone Then Оператор = R.Cells(i, 1) & ", " & R.Cells(i, 2) & " +7(" & Code & ") " & Mid(S, 4, 3) & "-" & Mid(S, 8, 2) & "-" & Mid(S, 10, 2) Exit Function End If Next i End Function
Конечно можно! Здравствуйте! С макросами я ваще не дружу! ( В ячейке удобнее, визуально, сначала номер потом оператор и регион. Как на листе коды, операторы, регионы. но необходимо это всё в одной ячейке, куда вводим номер. Вводим № телефона, Enter, и видим в ней результат Доступно только для пользователей. Фон красный, цвет шрифта в соответствии с читабельностью цветной графики и шрифта.
Конечно можно! Здравствуйте! С макросами я ваще не дружу! ( В ячейке удобнее, визуально, сначала номер потом оператор и регион. Как на листе коды, операторы, регионы. но необходимо это всё в одной ячейке, куда вводим номер. Вводим № телефона, Enter, и видим в ней результат Доступно только для пользователей. Фон красный, цвет шрифта в соответствии с читабельностью цветной графики и шрифта.Gold_Barsik
Сообщение отредактировал Gold_Barsik - Суббота, 24.02.2018, 21:21
Private Sub Worksheet_Change(ByVal Target As Range) Dim R, RR As Range Set RR = Range("D3:D10") If Not Intersect(RR, Target) Is Nothing Then Set R = ActiveCell.Offset(-1, 0) If Len(R.Value) = 10 Then R.Value = Оператор(R.Value) End If End Sub
Public Function Оператор(S As String) As String Dim R As Range, Code As String, Phone As Long Set R = Worksheets("коды, операторы, регионы").Range("A3:K104") Code = Left(S, 3) Phone = CLng(Right(S, Len(S) - 3)) Region = "" For i = 1 To R.Rows.Count If R.Cells(i, 2) <> "" Then Region = R.Cells(i, 2) If R.Cells(i, 9).Value = Code And R.Cells(i, 10).Value <= Phone And R.Cells(i, 11).Value >= Phone Then Оператор = "+7(" & Code & ") " & Mid(S, 4, 3) & "-" & Mid(S, 7, 2) & "-" & Mid(S, 9, 2) & " " & R.Cells(i, 1) & ", " & Region Exit Function End If Next i End Function
[/vba]
Gold_Barsik,
смотрите
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim R, RR As Range Set RR = Range("D3:D10") If Not Intersect(RR, Target) Is Nothing Then Set R = ActiveCell.Offset(-1, 0) If Len(R.Value) = 10 Then R.Value = Оператор(R.Value) End If End Sub
Public Function Оператор(S As String) As String Dim R As Range, Code As String, Phone As Long Set R = Worksheets("коды, операторы, регионы").Range("A3:K104") Code = Left(S, 3) Phone = CLng(Right(S, Len(S) - 3)) Region = "" For i = 1 To R.Rows.Count If R.Cells(i, 2) <> "" Then Region = R.Cells(i, 2) If R.Cells(i, 9).Value = Code And R.Cells(i, 10).Value <= Phone And R.Cells(i, 11).Value >= Phone Then Оператор = "+7(" & Code & ") " & Mid(S, 4, 3) & "-" & Mid(S, 7, 2) & "-" & Mid(S, 9, 2) & " " & R.Cells(i, 1) & ", " & Region Exit Function End If Next i End Function
Подскажите что мне с этим нужно сделать? Кроме как "смотрите". Файл открыл каким-то скачанным приложением. Посмотрел. И вошёл в ступор. Понимаю что в двух словах не объяснить, хотя бы подскажите дальнейшие мои действия. В макросах я не бум-бум.
Если я переставлю столбцы С и D вперёд как будет работать макрос? И строк у меня вышло 6470.
Ваш пример вроде работает как надо, но как он после сработает в "моей" книге? Строки (6470) подрезал, для уменьшения объёма. А формат обязательно xlsm ?
abtextime, Здравствуйте!
Подскажите что мне с этим нужно сделать? Кроме как "смотрите". Файл открыл каким-то скачанным приложением. Посмотрел. И вошёл в ступор. Понимаю что в двух словах не объяснить, хотя бы подскажите дальнейшие мои действия. В макросах я не бум-бум.
Если я переставлю столбцы С и D вперёд как будет работать макрос? И строк у меня вышло 6470.
Ваш пример вроде работает как надо, но как он после сработает в "моей" книге? Строки (6470) подрезал, для уменьшения объёма. А формат обязательно xlsm ?Gold_Barsik
Gold_Barsik, Файл с данным макросом настроен таким образом. что после ввода/корректировки ячейки (т.е. после нажатия Enter в ячейке) в диапазоне D3:D10 (строчка кода Set RR = Range("D3:D10")) происходит обращение к функции Оператор() , которая в эту же ячейку записывает строку с оператором и регионом
Чтобы адаптировать под ваш случай, замените в коде - "D3:D10" на ваш диапазон, куда будете вводить телефоны, - "A3:K104" на ваш диапазон, где расположены номера
Обращаю Ваше внимание, что на листе "коды, операторы, регионы" я добавил вычисляемые столбцы I, J и K, в которые распарсил код, начальный номер и конечный номер группы номеров. Значения этих столбцов я использую в коде функции. Можно парсинг сделать и в коде VBA, конечно. Только непонятно, почему у вас в столбца C, D и E такой зоопарк, нет единообразия. Это как-то неправильно, полагаю. Чтобы правильно парсить в коде функции все ваши варианты указания диапазона номеров, надо понимать. что их какое-то конечное и обозримое количество.
В заключение некое общее соображение. Если Вы собираетесь и дальше ставить такие довольно нетривиальные задачи, то потратьте несколько часов, посмотрите видео, почитайте статьи и хотя бы в самых общих чертах изучите, что такое макросы и UDF, как они работают и как их запускать и применять.
Gold_Barsik, Файл с данным макросом настроен таким образом. что после ввода/корректировки ячейки (т.е. после нажатия Enter в ячейке) в диапазоне D3:D10 (строчка кода Set RR = Range("D3:D10")) происходит обращение к функции Оператор() , которая в эту же ячейку записывает строку с оператором и регионом
Чтобы адаптировать под ваш случай, замените в коде - "D3:D10" на ваш диапазон, куда будете вводить телефоны, - "A3:K104" на ваш диапазон, где расположены номера
Обращаю Ваше внимание, что на листе "коды, операторы, регионы" я добавил вычисляемые столбцы I, J и K, в которые распарсил код, начальный номер и конечный номер группы номеров. Значения этих столбцов я использую в коде функции. Можно парсинг сделать и в коде VBA, конечно. Только непонятно, почему у вас в столбца C, D и E такой зоопарк, нет единообразия. Это как-то неправильно, полагаю. Чтобы правильно парсить в коде функции все ваши варианты указания диапазона номеров, надо понимать. что их какое-то конечное и обозримое количество.
В заключение некое общее соображение. Если Вы собираетесь и дальше ставить такие довольно нетривиальные задачи, то потратьте несколько часов, посмотрите видео, почитайте статьи и хотя бы в самых общих чертах изучите, что такое макросы и UDF, как они работают и как их запускать и применять.abtextime
И вообще, учитывая Вашу слабую подготовку, Вы бы лучше в Работа/Фриланс разместили, отдали бы весь ваш реальный файл исполнителю и получили бы достаточно быстро готовый результат.
А то жалко Вас, мучаетесь только ...
И вообще, учитывая Вашу слабую подготовку, Вы бы лучше в Работа/Фриланс разместили, отдали бы весь ваш реальный файл исполнителю и получили бы достаточно быстро готовый результат.
abtextime, блин!!!! а я их удалил, думал что за фигня прилипла к столбцам I, J и K. ((( Ваш файл открыл скачал приложение, т.к. нечем было открыть. С файлом я не мучаюсь, пытаюсь понять. офис у меня ТС 2003-й. может и древняя, но я напоминаю, такая существует. Макрос работает, только в виду перестановки столбцов перестал работать. Поэтому приложил свеженький файлик _Xl0000001.xls.
abtextime, блин!!!! а я их удалил, думал что за фигня прилипла к столбцам I, J и K. ((( Ваш файл открыл скачал приложение, т.к. нечем было открыть. С файлом я не мучаюсь, пытаюсь понять. офис у меня ТС 2003-й. может и древняя, но я напоминаю, такая существует. Макрос работает, только в виду перестановки столбцов перестал работать. Поэтому приложил свеженький файлик _Xl0000001.xls.Gold_Barsik
Сообщение отредактировал Gold_Barsik - Воскресенье, 25.02.2018, 19:19
Gold_Barsik, в последнем посте хотели файл приложить? не приложился
ок, не проблема, молодец, что пытаетесь вникнуть и понять, поможем
Попробуйте выполнить рекомендации из моего поста №8, приложите фалй, если что-то не будет получаться
И, да, заливка красным цветом оператора МТС выполняется условным форматированием. Для Билайн, Мегафон и и т.д. добавьте соответствующие правила в УФ, с другой заливкой
Gold_Barsik, в последнем посте хотели файл приложить? не приложился
ок, не проблема, молодец, что пытаетесь вникнуть и понять, поможем
Попробуйте выполнить рекомендации из моего поста №8, приложите фалй, если что-то не будет получаться
И, да, заливка красным цветом оператора МТС выполняется условным форматированием. Для Билайн, Мегафон и и т.д. добавьте соответствующие правила в УФ, с другой заливкойabtextime
abtextime, файл приложен в Сообщение № 7. рекомендации из Вашего поста №8 выполнил. В принципе работает, но операторов целое ведро. Трёх УФ на всех не хватает. Может цвет ячейки брать из листа "коды, операторы, регионы"? Что скажите?
abtextime, файл приложен в Сообщение № 7. рекомендации из Вашего поста №8 выполнил. В принципе работает, но операторов целое ведро. Трёх УФ на всех не хватает. Может цвет ячейки брать из листа "коды, операторы, регионы"? Что скажите?Gold_Barsik
А почему именно три УФ? Делайте сколько угодно. Разумеется, можно и в код VBA зашить выбор заливки и шрифта, просто это более трудоёмко. И не понятно, почему надо игнорировать такой удобный инструмент. как УФ
В любом случае - на сегодня всё. Желаю удачи
А почему именно три УФ? Делайте сколько угодно. Разумеется, можно и в код VBA зашить выбор заливки и шрифта, просто это более трудоёмко. И не понятно, почему надо игнорировать такой удобный инструмент. как УФ
В любом случае - на сегодня всё. Желаю удачиabtextime
If Len(R.Value) = 10 Then R.Value = Оператор(R.Value)
[/vba]заменить на, условно,
[vba]
Код
If Len(R.Value) = 10 Then R.Value = Оператор(R.Value) if R.Value Like "МТС,*" then R.Font.Color = R.Interior.Color = End If if R.Value Like "Билайн,*" then R.Font.Color = R.Interior.Color = End If
и т.д.
End If
[/vba]
Gold_Barsik,
понятно
ну можно этот фрагмент кода[vba]
Код
If Len(R.Value) = 10 Then R.Value = Оператор(R.Value)
[/vba]заменить на, условно,
[vba]
Код
If Len(R.Value) = 10 Then R.Value = Оператор(R.Value) if R.Value Like "МТС,*" then R.Font.Color = R.Interior.Color = End If if R.Value Like "Билайн,*" then R.Font.Color = R.Interior.Color = End If
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
