Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на Basic / VBA

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 1.824 RSS
←   Декабрь 2008   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


За последние 60 дней ни разу не выходила


Сайт рассылки: http://prog.rusfaq.ru/basic
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

1.824 подписчиков
0 за неделю
←   Все выпуски   →

RusFAQ.ru: Программирование на Basic / VBA


Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

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

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

Шичко Игорь
Статус: Практикант
Рейтинг: 164
∙ повысить рейтинг >> 		Moryarty
Статус: Студент
Рейтинг: 149
∙ повысить рейтинг >> 		6a3uJI
Статус: 7-й класс
Рейтинг: 84
∙ повысить рейтинг >>

/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Basic/VBA

Выпуск № 839
от 14.12.2008, 17:35

Администратор:Калашников О.А.
В рассылке:Подписчиков: 260, Экспертов: 29
В номере:Вопросов: 1, Ответов: 1
Нам важно Ваше мнение об этой рассылке.
Оценить этот выпуск рассылки >>

Вопрос № 153625: Добрый вечер, Уважаемые Эксперты! Помогите, пожалуйста с решением задачи: Дана строка произвольной длины. Выяснить, имеются ли в строке числа и выделить их. <div style="margin:15px; margin-top:10px"><div><b><font color="gray">Код:</font><...

Вопрос № 153.625
Добрый вечер, Уважаемые Эксперты!
Помогите, пожалуйста с решением задачи: Дана строка произвольной длины. Выяснить, имеются ли в строке числа и выделить их.

Код:

Sub Ex()
Dim строчка As String
Sheets("Лист1").Select
Cells.Clear
Cells(1, 1) = "Лабораторная
работа №2. Обработка строк"
Cells(2, 1) = "Задание:"
Cells(3, 1) = "Выяснить имеются ли в строке числа, и выделить их."
Cells(4, 1) = "Выполнил Ст.гр."
Cells(5, 1) = "Исходный массив:"
строчка = InputBox("введите предложение из нескольких слов, используя цифры")
Cells(6, 1) = строчка
Cells(7, 1) = "Результат решения"
Cells(8, 1) = RazborStroki(строчка)
  With Range("A1:A
 5, A7").Font
     .Name = "Times New Roman"
     .Bond = True
     .Size = 14
  End With
End Sub

'возвращает TRUE, если аргумент является символом-разделителем слов
'(пробел, кавычки, точка, запятая и тд)
Public Function IsDelimeter(simbol As String) As Boolean
If simbol = " " Or simbol = """" Or simbol = "'" Or simbol = "." Or simbol = "," Then IOsDelimeter = True Else IsDelimeter = False
End
Function

'возвращает True, если аргумент является цифрой
' 1 2 3 4 5 6 7 8 9 0
Public Function IsChislo(simbol As String) As Boolean
simbol = UCase(simbol)
If simbol = "1" Or simbol = "2" Or simbol = "3" Or simbol = "4" Or simbol = "5" Or simbol = "6" Or simbol = "7" Or simbol = "8" Or simbol = "9" Or simbol = "0" Then IsChislo = True Else Is
 Chislo = False
End Function


'разбираем строки на слова и показываем в некоторых соответствие с заданным критерием
Public Function RazborStroki(s As String) As String
Dim i, p As Integer 'вспомогательные переменные
Dim flag As Boolean 'флаг, при разборе строки он равен True "внутри" слова, иначе False
Dim words As New Collection 'коллекция(список) для хранения выделенных слов
Dim word As Variant 'отдельное слово из коллекции
Dim mess As String 'строка
для визуального вывода результата
'смотрим: первый символ строки - разделитель или нет
  If IsDelimeter(Mid(s, 1, 1)) Then
     flag = False
     Else
     flag = True
  End If
'цикл разбора строки на слова
For i = 1 To Len(s)
  If IsDelimeter(Mid(s, i, 1)) = False And flag = False Then
'если очередной символ строки - не разделитель, и мы не внутри слова, то это означает начало нового слова
   p = i
   flag = True
   End If
 If IsDelimeter(Mid(s, i, 1)) = True And flag = True Then
' иначе, т.е. если встречен разделитель и мы "внутри" слова,
' то значит очередное слово закончилось и его надо выделить
' и добавить в список найденных
 words.Add Mid(s, p, i - p)
 flag = False
 End If
Next i
'если по завершению цикла флаг остался true, тогда надо выделить последнее слово
If flag = True Then words.Add Mid(s, p, Len(s) - p + 1)
'печатаем слова, которые начинаются
и заканчиваются на гласные
mess = ""
For Each word In words
  If IsChislo(Mid(word, 1, 1)) = True And IsChislo(Mid(word, Len(word)), 1) = True Then mess = mess + word + ""
  Next
  RazborStroki = mess
End Function


не могу найти и, собственно, исправить ошибку...
Отправлен: 09.12.2008, 17:05
Вопрос задала: Amidala (статус: Посетитель)
Всего ответов: 1
Мини-форум вопроса >>> (сообщений: 0)
Отвечает: PsySex
Здравствуйте, Amidala!
Я переписал вашу функцию RazborStroki, она получилась намного компактней из-за того что я использовал встроенные функции VBA для определения - является ли символ числом и функции разбивки строки в массив по разделителю. Код в приложении, прокоментирован.

Приложение:

---------
Bom Shankar!

Ответ отправил: PsySex (статус: Специалист)
Ответ отправлен: 10.12.2008, 10:46

Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 238193 на номер 1151 (Россия) | Еще номера >>
  • Отправить WebMoney:
    • Вам помогли? Пожалуйста, поблагодарите эксперта за это!

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

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

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

    Приложение (если необходимо):

    * Код программы, выдержки из закона и т.п. дополнение к вопросу.
    Эта информация будет отображена в аналогичном окне как есть.

    Обратите внимание!
    Вопрос будет отправлен всем экспертам данной рассылки!
    Для того, чтобы отправить вопрос выбранным экспертам этой рассылки или
    экспертам другой рассылки портала RusFAQ.ru, зайдите непосредственно на RusFAQ.ru.


    Форма НЕ работает в почтовых программах The BAT! и MS Outlook (кроме версии 2003+)!
    Чтобы отправить вопрос, откройте это письмо в браузере или зайдите на сайт RusFAQ.ru.

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)
    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров >>

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.

    © 2001-2008, Портал RusFAQ.ru, Россия, Москва.
    Авторское право: ООО "Мастер-Эксперт Про"
    Техподдержка портала, тел.: +7 (926) 535-23-31
    Хостинг: "Московский хостер"
    Поддержка: "Московский дизайнер"
    Авторские права | Реклама на портале

    ∙ Версия системы: 5.13 от 01.12.2008

    		Яндекс Rambler's Top100
    RusFAQ.ru | MosHoster.ru | MosDesigner.ru
    RusIRC.ru | Kalashnikoff.ru | RadioLeader.ru
    В избранное