Главная Вход в систему Регистрация
Задать вопрос Консультации Пользователи Форум
О системе Помощь
Задать вопрос экспертам
Консультация № 172964
06.10.2009, 09:37
0.00 руб.
0 5 1
Компьютеры Программирование
Здраствуйте уважаемые эксперты. Буду рад вашей помощи. Имеется документ MS Excel в котором содержится набор телефонных номеров в виде (код)номер. все номера необходимо выделить в три группы. Первая - назовем условно "белый список" - номера известны заранее (можно задать в виде маски код и первые две цифры номера или перечислением), вторая - "черный список" - номера также известны заранее (около 40) и третья группа - "неизвестные". Помогите как написать макрос с возможностью вывода из общего списка отдельных групп. Заранее благодарен.

Обсуждение

давно
Megaloman
Модератор
137394
1850
06.10.2009, 11:43
общий
vitalkis:
Объясните, какой признак в телефонном номере определяет его принадлежность к группе. Желательно на наглядном примере.
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Неизвестный
06.10.2009, 11:59
общий
Megaloman:
Я наверно неправильно пояснил. Есть документ MS Excel содержащий записи (телефонные номера). Необходимо или отсортировать или выделить разными цветами эти номера по трем группам. Для черного списка признака нет просто есть набор из 40 номеров. С белым списком сложнее там есть также набор сотовых номеров (как константы) и набор рабочих номеров (например 38591 632448 необходимо осуществить проверку первых 7 символов(код и первые две цифры) попадают ли они в список "белых" номеров). В результате необходимо каким то образом выделить все номера в документе из черного списка, из белого списка, и все номера не попавшие ни в черный ни в белый. Желательны конечно два варианта: первый - это когда остается весь список и записи допустим раскрашиваются в три разных цвета и второй - вывод каждого из списков по отдельности.
давно
Megaloman
Модератор
137394
1850
06.10.2009, 15:46
общий
vitalkis:
Простите мою непонятливость. Но хорошо поставленная задача - это 90% решения. Готов поделиться гонораром за ответ на Ваш вопрос в этой пропорции .
Есть документ MS Excel содержащий записи (телефонные номера).
- то есть там сплошняком идут всякие номера. Это какой-то отдельный лист в таблице?
Для черного списка признака нет просто есть набор из 40 номеров.
- где он, этот набор, на отдельном листе, в отдельной таблице?
необходимо осуществить проверку первых 7 символов(код и первые две цифры)
- это одна какая-то последовательность, или несколько последовательностей? Где они задаются, хранятся, откуда их можно взять? Как это выглядит?
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Неизвестный
07.10.2009, 04:46
общий
Megaloman:
Все проще. Документ имеет структуру стандарной распечатки телефонной компании, т.е. имеется таблица в которой указаны такие поля: дата разговора, с какого телефона, на какой телефон (столбец С), код города, длительность, сумма. Отфильтровать нужно эти записи по столбцу С.

Набор из сорока номеров для черного списка пока на отдельном листе (А1:А40). Оптимальней было бы конечно считывать этот набор с отдельного файла.

Последовательностей для белого списка несколько и сейчас они хранятся также как и для церного списка на отдельном листе. В идеале конечно хотелось бы также считывать из файла.

Извините, что точно все не могу описать. Проблема в том, что я сам окончательно не определился в том каким путем будет проще получить конечный результат. Поэтому все так неопределенно. Буду рад любой помощи.
давно
Megaloman
Модератор
137394
1850
07.10.2009, 13:48
общий
это ответ
Здравствуйте, vitalkis.
Вот возможные пути решения вашей задачи. Это только пути решения, вследствие нечёткости постановки. Нет проблем взять данные из текстового файла. Нет проблем довести решение до совершенства. Но не хотелось этого делать из-за нечеткой постановки. А предложенные примеры работоспособны и задачу в нулевом приближении решают.
Итак:
На одном листе таблицы (у меня он называется Все) имеем все телефоны
Еще на одном листе таблицы (у меня он называется Черные) имеем список черных телефонов
Еще на одном листе таблицы (у меня он называется Белые) имеем список префиксов белых телефонов

Макрос забирает в массив справочник черных телефонов и префиксов белых с листов таблицы Excel (настройте их расположение, а, в принципе, не проблема брать их из текстовых файлов),
просматривает все номера телефонов (диапазон где они расположены - прописать в макросе)
в зависимости от результата сравнения со справочными данными форматирует ячейку с телефоном в нужный цвет
Код:
Sub telefon()
' Исходные данные --------------------------------------------------------------------------
    ListBlack = "Черные"                            ' Наименование черного листа
    ListWhite = "Белые"                             ' Наименование белого листа
    ListAll = "Все"                                 ' Исследуемый лист Все телефоны
    
    RangeBlack = "A1:A12"                            ' Диапазон клеток со справочником черных телефонов
    RangeWhite = "A1:A3"                             ' Диапазон клеток со справочником белых телефонов
    RangeAll = "C4:C194"                             ' Диапазон клеток со всеми телефонами
'-------------------------------------------------------------------------------------------
    
    Dim MWhite As Variant, MBlack As Variant
    
    MWhite = Sheets(ListWhite).Range(RangeWhite)
    MBlack = Sheets(ListBlack).Range(RangeBlack)
    
    NBlack = UBound(MBlack, 1)
    NWhite = UBound(MWhite, 1)
    
    Sheets(ListAll).Select
    Range(RangeAll).Font.ColorIndex = 0
    Range(RangeAll).Interior.ColorIndex = xlNone
   
    For Each TelNum In Range(RangeAll)
       xx = TelNum.Value
       x = CStr(xx)
       
       For i = 1 To NWhite
            y = CStr(MWhite(i, 1))
            If Mid(x, 1, Len(y)) = y Then
                TelNum.Interior.ColorIndex = 35     ' Зелёный
                Exit For
            End If
       Next
       
       For i = 1 To NBlack
            If xx = MBlack(i, 1) Then
                TelNum.Interior.ColorIndex = 3     ' Красный
                Exit For
            End If
       Next
       
    Next
End Sub

Вот еще вариант:
В отличие от первого, организуем дополнительный столбец, где словами записываем статус ячейки.
Что в этом хорошего: - можно поставить на таблицу автофильтр и фильтровать строки в таблице по статусу - очень удобно
Код:
Sub telefon()
' Исходные данные --------------------------------------------------------------------------
    ListBlack = "Черные"                            ' Наименование черного листа
    ListWhite = "Белые"                             ' Наименование белого листа
    ListAll = "Все"                                 ' Исследуемый лист Все телефоны
    
    RangeBlack = "A1:A12"                            ' Диапазон клеток со справочником черных телефонов
    RangeWhite = "A1:A3"                             ' Диапазон клеток со справочником белых телефонов
    RangeAll = "C4:C194"                             ' Диапазон клеток со всеми телефонами
    
    NStatus = 3                                      ' Через сколько столбцов с телефонами напишем статус телефона
'-------------------------------------------------------------------------------------------
    
    Dim MWhite As Variant, MBlack As Variant
    
    MWhite = Sheets(ListWhite).Range(RangeWhite)
    MBlack = Sheets(ListBlack).Range(RangeBlack)
    
    NBlack = UBound(MBlack, 1)
    NWhite = UBound(MWhite, 1)
    
    Sheets(ListAll).Select
    Range(RangeAll).Font.ColorIndex = 0
    Range(RangeAll).Interior.ColorIndex = xlNone
    
   
    For Each TelNum In Range(RangeAll)
       xx = TelNum.Value
       x = CStr(xx)
       TelNum.Offset(0, NStatus).Value = "Неизвестный"
       
       For i = 1 To NWhite
            y = CStr(MWhite(i, 1))
            If Mid(x, 1, Len(y)) = y Then
                TelNum.Interior.ColorIndex = 35
                TelNum.Offset(0, NStatus).Value = "Белый"
                Exit For
            End If
       Next
       
       For i = 1 To NBlack
            If xx = MBlack(i, 1) Then
                TelNum.Interior.ColorIndex = 3
                TelNum.Offset(0, NStatus).Value = "Черный"
                Exit For
            End If
       Next
       
    Next
End Sub

Фаил с моими примерами прикрепил к ответу - скачайте, смотрите
Прикрепленные файлы:
5
Спасибо. Пути решения меня и интересовали. Остальное доработаю. То что нужно.
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Форма ответа