Хостинг портала RFpro.ru:
Московский хостер
Профессиональный платный хостинг на базе Windows 2008

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

Гуревич Александр Львович Статус: 10-й класс Рейтинг: 958 ∙ повысить рейтинг »

Megaloman Статус: Бакалавр Рейтинг: 600 ∙ повысить рейтинг »

Botsman Статус: Специалист Рейтинг: 514 ∙ повысить рейтинг »

Вопрос № 172964: Здраствуйте уважаемые эксперты. Буду рад вашей помощи. Имеется документ MS Excel в котором содержится набор телефонных номеров в виде (код)номер. все номера необходимо выделить в три группы. Первая - назовем условно "белый список" - номера ...

Здраствуйте уважаемые эксперты. Буду рад вашей помощи. Имеется документ MS Excel в котором содержится набор телефонных номеров в виде (код)номер. все номера необходимо выделить в три группы. Первая - назовем условно "белый список" - номера известны заранее (можно задать в виде маски код и первые две цифры номера или перечислением), вторая - "черный список" - номера также известны заранее (около 40) и третья группа - "неизвестные". Помогите как написать макрос с возможностью вывода из общего списка отдельных групп. Заранее благодарен.

Отправлен: 06.10.2009, 09:37
Вопрос задал: vitalkis, Посетитель
Всего ответов: 1
Страница вопроса »

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.ColorInd
 ex = 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, NSta
 tus).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

Ответ отправил: Megaloman, Бакалавр
Ответ отправлен: 07.10.2009, 13:48

Оценка ответа: 5
Комментарий к оценке:
Спасибо. Пути решения меня и интересовали. Остальное доработаю. То что нужно.

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255122 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

В одной строке в стоящих подряд ячейках содержатся слова(набор любых символов). Эти слова образуют предложение. Конец предложения - пустая ячейка. Таких строк в таблице Excel несколько. Создать модуль, который выводит в файл output.txt строки - предложения, получающиеся их этих слов, с пробелов в качестве разделителя. Текстовый файл input.txt содержит некоторое количество предложений - строк символов, пробел - разделитель слов. Ввести из текстового файла предложения и разместить их в строках таблицы Excel с номерами 1, 2, ... Каждое предложение разбить на слова и разместить их в рядом стоящие ячейки одной строки, начиная с столбца А. На рабочем листе разместить две кнопки для обращения к процедурам.

Отправлен: 06.10.2009, 10:29
Вопрос задал: Евгений Викторович, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
Sub Кнопка1_Щелчок() i = 0 j = 1 Open "c:\output.txt" For Append As #1 Do i = i + 1 If Cells(i, j).Value = "" Then Exit Do Do If Cells(i, j).Value = "" Then j = 1 Exit Do Else stroka = stroka & Cells(i, j).Value & " " End If j = j + 1 Loop Print #1, Trim(stroka) stroka = "" Loop Close End Sub Sub Кнопка2_Щелчок() Open "c:\input.txt" For Input As #1 Do Until EOF(1) Line Input #1, rec i = i + 1 posbegin = 1 posend = 1 Do Until posend = 0 j = j + 1 posend = InStr(posbegin, rec, " ") If posend = 0 Then wrd = Mid(rec, posbegin, Len(rec) - posbegin + 1) Else wrd = Mid(rec, posbegin, posend - posbegin) End If Cells(i, j).Value = wrd posbegin = posend + 1 Loop j = 0 Loop Close End Sub

Ответ отправил: NRJ, 3-й класс
Ответ отправлен: 06.10.2009, 12:48

Оценка ответа: 5
Комментарий к оценке:
Спасибо, все работает

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255057 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает DVS, 1-й класс :
Здравствуйте, Евгений Викторович.
В приложении представлены 2 макроса, которые решают поставленные вопросы.
К сожалению Вы не указали в каком Excel'е Вы работаете, поэтому приведу два варианта создания кнопок.
Excel 2003
Если не выведена панель «Формы», то её необходимо вывести. Вид – Панели инструментов –Формы.
На появившейся панели щёлкаем по кнопке и выбираем её место расположение на листе.
Открывается окно для назначения макроса, нажимаем «Создать ». Сразу попадаем в редактор Visual Basic,
где будет уже создана пустая процедура вида
Sub Кнопка1_Щелчок()

End Sub
Вместо неё и вставляем процедуру Sub TextOut(), либо просто добавляем код, который между
Sub TextOut() и End Sub. Если меняем название Кнопка1_Щелчок() на TextOut(), то не забываем
сменить его и на кнопке ( правой кнопкой мыши по кнопке, «Назначить макрос»).
Аналогично добавляем вторую кнопку на лист с учётом, что макрос надо взять TextIn().

Excel 2007
Е сли нет вкладки «Разработчик», то добавляем её, Кнопка «Office», Параметры Excel и в разделе «Основные»
ставим галочку «Показывать вкладку «Разработчик» на ленте».
Переходим на вкладку «Разработчик», далее «Вставить», и добавляем кнопку из «Элементы управления формы».
Далее действуем аналогично, как показано выше.

Комментарии по работе макросов даны в тексте программы.

Приложение:
Sub TextOut() Dim i As Integer Dim k As Integer Dim strPath As String Dim strTemp As String strPath = ActiveWorkbook.Path & "\output.txt" \'Указываем полный путь файла вывода. В даномм случае он будет создан там же где и наша книга i = 1 \'Если текст начинается с первой строки книги \'i = Selection.Row \'иначе ставим курсор на нужную строку и выбираем этот вариант k = 1 strTemp = "" Open strPath For Output As #1 \'Открываем файл вывода, если он уже есть, то он будет переписан While Cells(i, 1) <> "" And i <= 35000 \'Пробегаем все непустые строки, но не более 35000 While Cells(i, k) <> "" And k <= 300 \'Пробегаем все непустые колонки, но не более 300 strTemp = strTemp & Cells(i, k) & " " \'Составляем предложение k = k + 1 Wend Print #1, RTrim(strTemp) \'Выводим его в файл strTemp = "" i = i + 1 k = 1 Wend Close #1 \'Закрываем файл MsgBox ("FINISH!") \'Выводим сообщение об окончании работы макроса End Sub Sub TextIn() On Error GoTo ErrorHandler Dim i As Integer Dim k As Integer Dim l As Integer Dim strPath As String Dim strTemp As String Dim strCell As String strPath = ActiveWorkbook.Path & "\input.txt" \'Указываем полный путь файла ввода. В даномм случае предпологаем, что он находится там же, где и наша книга i = 1 k = 1 strTemp = "" strCell = "" Open strPath For Input As #1 \'Открываем файл, файл должен существовать, иначе будет выведено сообщение об ошибке и макрос закончит работу While Not EOF(1) And i <= 35000 \'Пробегаем весь файл, но не более 35000 строк Line Input #1, strTemp For l = 1 To Len(strTemp) Step 1 \'Пробегаем всю строку If Mid(strTemp, l, 1) <> " " And k < 300 Then \'и разбиваем на слова. Предложение ограничено 300 словами strCell = strCell & Mid(strTemp, l, 1) \'Каждое слово записываем в ячейку Else Cells(i, k) = strCell strCell = "" k = k + 1 End If Next l Cells(i, k) = strCell \'и последнее strCell = "" k = 1 i = i + 1 Wend Close #1 \'Закрываем файл MsgBox ("FINISH!") \'Выводим сообщение об окончании работы макроса Exit Sub ErrorHandler: MsgBox (Err.Description) \'Если файл не найдем, выводим сообщение End Sub \'и завершаем работу

Ответ отправил: DVS, 1-й класс
Ответ отправлен: 06.10.2009, 16:16

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255082 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Добрый день, уважаемые эксперты. VBA Excel

Мой вопрос заключается в том, как
создать программно несколько объектов на форме в зависимости от значения textbox

Весь процесс выглядит следующим образом. Я набираю, например число, 5 в textbox. Нажимаю кнопку и появляется новая форма с 5 тью textbox определённого размера и одной кнопкой. И что бы была возможность наложить какое либо событие на кнопку.

Спасибо за внимание.

Отправлен: 06.10.2009, 15:21
Вопрос задал: Соколов В.В., Посетитель
Всего ответов: 2
Страница вопроса »

• Создаем два класса. Один для событий, другой — для компонентов. В примере это классы EventsOfControls и ControlsOnForm соответственно;
  
• Добавляем в проект форму (программно). Это делает процедура CreateForm(NumberOfTextBoxes As Integer), которой в качестве параметра передается количество текстовых полей, которое должно быть на форме;
  
• Программно записываем процедуру инициализации формы. В той же CreateForm;
  
• Когда мы показываем созданную, но еще пустую форму, то запускается про цедура ее инициализации (UserForm_Initialize()), в которой записан вызов процедуры, добавляющей компоненты на форму GetControlsForForm(ByVal oForm As Object, ByVal NumberOfTextBoxes As Integer);
  
• В процедуре GetControlsForForm мы добавляем в цикле текстовые поля, связываем их с классом событий и добавляем в коллекцию класса компонентов.

Ответ отправил: Витер Александр Анатольевич, 9-й класс
Ответ отправлен: 06.10.2009, 17:01

Оценка ответа: 5
Комментарий к оценке:
Программа работает, вопрос раскрыт полностью! Спасибо большое, помогло. Язык написания понятен, исчерпывающие комментарии и принцип работы.

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255084 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает NRJ, 3-й класс :
Здравствуйте, Соколов В.В..
на форме создаём текстбокс и кнопку, а также добавляем модуль и соответственно пишем на кнопку и в модуль следующие процедуры

Приложение:
на форме Private Sub CommandButton2_Click() MakeForm (TextBox1.Text) End Sub в модуле Sub MakeForm(k As String) Dim TempForm As Object \'VBComponent Dim NewButton As MSForms.CommandButton Dim btn As MSForms.TextBox Dim Line As Integer Dim TheForm Application.VBE.MainWindow.Visible = False \' Создание диалогового окна UserForm Set TempForm = ThisWorkbook.VBProject. _ VBComponents.Add(3) \'vbext_ct_MSForm With TempForm .Properties("Caption") = "Временная форма" .Properties("Width") = 200 .Properties("Height") = 100 End With \' Добавление элемента управления CommandButton Set NewButton = TempForm.Designer.Controls _ .Add("forms.CommandButton.1") With NewButton .Caption = "Щелкни!" .Left = 60 .Top = 40 End With Dim tp As Integer tp = 5 For i = 1 To Int(k) Set btn = TempForm.Designer.Controls.Add("Forms.TextBox.1") btn.Left = 5 btn.Top = tp btn.Width = 20 btn.Height = 10 tp = tp + 10 Next With TempForm.CodeModule Line = .CountOfLines .InsertLines Line + 1, "Private Sub CommandButton1_Click()" .InsertLines Line + 2, "MsgBox ""Привет!""" .InsertLines Line + 3, "Unload Me" .InsertLines Line + 4, "End sub" End With \' Set MakeForm = TempForm \' Отображение диалогового окна UserForm VBA.UserForms.Add(TempForm.Name).Show \' Удаление диалогового окна UserForm ThisWorkbook.VBProject.VBComponents.Remove TempForm End Sub

Ответ отправил: NRJ, 3-й класс
Ответ отправлен: 06.10.2009, 17:22

Оценка ответа: 4
Комментарий к оценке:
Спасибо за ответ. 4 потому что есть с чем сравнивать.

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255086 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »