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

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

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 1.824 RSS
←   Июнь 2010   →
 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


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


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

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

Статистика

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

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


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

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

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

Гаряка Асмик
Статус: Профессионал
Рейтинг: 4304
∙ повысить рейтинг » 		Vasiliy83
Статус: Бакалавр
Рейтинг: 1729
∙ повысить рейтинг » 		Megaloman
Статус: Профессионал
Рейтинг: 1413
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И ПО / Программирование / Basic/VBA

Номер выпуска:1038
Дата выхода:16.06.2010, 20:00
Администратор рассылки:Калашников О.А., Руководитель
Подписчиков / экспертов:214 / 88
Вопросов / ответов:1 / 2

Вопрос № 179049: Здравствуйте, уважаемые эксперты. Помогите с задачей на VBA. Две строки матрицы назовем похожими, если совпадают множества чисел, встречающихся в этих строках. Найти все пары непохожих строк в заданной матрице....

Вопрос № 179049:

Здравствуйте, уважаемые эксперты.
Помогите с задачей на VBA.
Две строки матрицы назовем похожими, если совпадают множества чисел, встречающихся в этих строках. Найти все пары непохожих строк в заданной матрице.

Отправлен: 11.06.2010, 19:31
Вопрос задал: Микушов Сергей, Посетитель
Всего ответов: 2
Страница вопроса »

Отвечает Andrew Kovalchuk, Студент :
Здравствуйте, Микушов Сергей.
Приведенный в приложении код демонстрирует один из возможных вариантов решения.

Приложение:

-----
Временная неудача лучше временной удачи

Ответ отправил: Andrew Kovalchuk, Студент
Ответ отправлен: 12.06.2010, 02:05
Номер ответа: 262074

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

    • Отвечает Megaloman, Профессионал :
    Здравствуйте, Микушов Сергей.
    Приведенный ниже код демонстрирует еще один из возможных вариантов решения. Отладку делал в VBA как макрос Excel. Постарался написать подробные комментарии для пояснения хода решения 179049.xls (32.5 кб)
    Код:
    Sub Different()
        Const N As Integer = 10             ' Число строк в матрице
        Const M As Integer = 5              ' Число столбцов в матрице
        Const lowerbound As Integer = 0     ' Минимально возможный элемент в матрице
        Const upperbound As Integer = 2     ' Максимально возможный элемент в матрице
        
        ReDim A(N - 1, M - 1) As Integer    ' Исследуемый массив (матр
 ица) N*M элементов
        ReDim Atmp(M - 1) As Integer        ' Вспомогательный массив для сортировки строки
        ReDim S(N - 1) As String            ' Множество чисел каждой строки в символьном виде (с разделителем пробел)
        
    ' -------------------------------------- Для вывода в Excel ------------
                                            Range("A:IV").ClearContents         ' Чистим текущий лист таблицы Excel
            
        For i = 0 To N - 1                  '
Заполняем матрицу случайными числами
            For j = 0 To M - 1
                A(i, j) = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

    ' -------------------------------------- Для вывода в Excel ------------
                                            Range("A1").Offset(i, 5 + j) = A(i, j)   ' Выводим сгенерированную матрицу на текущий лист таблицы Excel
            
            Next
        Next
        
        For k = 0 To N - 1            
       ' Сортируем каждую строку, например, по возрастанию
            
            S(k) = ""
            For j = 0 To M - 1              ' Переписываю строку матрицы во вспомогательный массив
                Atmp(j) = A(k, j)
            Next
            
            For i = 0 To M - 1               ' Сортирую его например, по возрастанию
                
                ii = i
                For j = i To M - 1
                    If Atmp(ii) > Atmp(j) Then ii = j
                Next
        
       
                AA = Atmp(ii)
                Atmp(ii) = Atmp(i)
                Atmp(i) = AA
                
                If i = 0 Then
                    S(k) = CStr(Atmp(i))                                ' Формирую множество уникальных чисел каждой строки в символьном массиве
                Else
                    If AB <> AA Then S(k) = S(k) + " " + CStr(Atmp(i))  ' Формирую множество уникальных чисел каждой строки в символьном массиве            End If
                AB = AA
                
            Next
        Next
        
        Rezult = ""
        For i = 0 To N - 1                  ' Для каждой строки ищем все непохожие строки (если множество чисел строки, записанных в элементы строкового массива не совпадает) 
            
    ' -------------------------------------- Для вывода в Excel множества уникальных чисел в строке
                                            Range("A1").Offset(i, 2) = S(i)
        
   
            SS = ""
            For j = 0 To N - 1
                If S(i) <> S(j) Then SS = SS + " " + CStr(j + 1)
            Next
            
            SS = Trim(SS)
            If SS <> "" Then
                SS = "Для строки " + CStr(i + 1) + " непохожие " + SS
                Rezult = Rezult + SS + vbCrLf

    ' -------------------------------------- Для вывода в Excel ------------
                    
                         Range("A1").Offset(i, 3) = SS
            
            End If
        Next

        If Rezult <> &q
uot;" Then
            MsgBox Rezult
        Else
            MsgBox "В матрице все строки похожие"
        End If

    End Sub

    -----
    Нет времени на медленные танцы

    Ответ отправил: Megaloman, Профессионал
    Ответ отправлен: 12.06.2010, 21:13
    Номер ответа: 262080

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

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

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

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

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

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

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

    © 2001-2010, Портал RFpro.ru, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2010.6.16 от 26.05.2010
    В избранное