RFpro.ru: Пакет Microsoft Office

  Все выпуски  

RFpro.ru: Пакет Microsoft Office


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

Лучшие эксперты в разделе

CradleA
Статус: Мастер-Эксперт
Рейтинг: 278
∙ повысить рейтинг »
Megaloman
Статус: Мастер-Эксперт
Рейтинг: 209
∙ повысить рейтинг »
solowey
Статус: Профессор
Рейтинг: 83
∙ повысить рейтинг »

Пакет MSOffice

Номер выпуска:1035
Дата выхода:08.06.2021, 22:15
Администратор рассылки:Megaloman (Мастер-Эксперт)
Подписчиков / экспертов:3 / 29
Вопросов / ответов:2 / 2

Консультация # 201076: Здравствуйте! У меня возникли сложности с таким вопросом: В массив A считать 100 действительных чисел, находящихся в первом столбце рабочего листа. Отсортировать элементы, стоящие на нечетных местах по возрастанию, а на четных местах по убыванию элементов. Полученный массив записать во второй столбец. Выделить разным цветом ячейки, соответствующ...
Консультация # 201077: Здравствуйте! Прошу помощи в следующем вопросе: При помощи датчика случайных чисел заполнить целочисленную квадратную матрицу A порядка N (N ввести с клавиатуры). Столбцы матрицы A, имеющие нечетную сумму элементов, отсортировать по убыванию элементов. Вывести сумму элементов столбцов, а также матрицу A до и после сортировки. Все элементы отсорт...

Консультация # 201076:

Здравствуйте! У меня возникли сложности с таким вопросом:
В массив A считать 100 действительных чисел, находящихся в первом столбце рабочего листа. Отсортировать элементы, стоящие на нечетных местах по возрастанию, а на четных местах по убыванию элементов. Полученный массив записать во второй столбец. Выделить разным цветом ячейки, соответствующие возрастающим и убывающим подмассивам. (Решить надо на языке VBA в макросе, можно просто код) Заранее огромное спасибо!!!

Дата отправки: 03.06.2021, 21:53
Вопрос задал: 23071996 (Посетитель)
Всего ответов: 1
Страница онлайн-консультации »


Консультирует Megaloman (Мастер-Эксперт):


Код
Sub A100()

Const R1 = "A1"     'С какой ячейки считываем данные
Const N = 100       'Количество данных

r1n = Range(R1).Offset(N - 1, 0).Address
R2 = Range(R1).Offset(0, 1).Address
R2N = Range(R2).Offset(N - 1, 0).Address

With Range(R2 + ":" + R2N)
    .ClearContents
    .Interior.Pattern = xlNone
End With

Mass = Range(R1 + ":" + r1n)
Call MySort(Mass, N, 1, R2)
Call MySort(Mass, N, 2, R2)

Range(R2 + ":" + R2N) = Mass

End Sub
Sub MySort(M, N, k, R)
    If k = 1 Then
        For i = 1 To N Step 2
            m1 = M(i, 1)
            Range(R).Offset(i - 1, 0).Interior.Color = 5296274
            For j = i To N Step 2
                If M(j, 1) < m1 Then
                    M(i, 1) = M(j, 1)
                    M(j, 1) = m1
                    m1 = M(i, 1)
                End If
            Next
        Next
    End If
    If k = 2 Then
        For i = 2 To N Step 2
            m1 = M(i, 1)
            Range(R).Offset(i - 1, 0).Interior.Color = 65535
            For j = i To N Step 2
                If M(j, 1) > m1 Then
                    M(i, 1) = M(j, 1)
                    M(j, 1) = m1
                    m1 = M(i, 1)
                End If
            Next
        Next
    End If
End Sub

ya21060409.xlsm (17.6 кб)

Консультировал: Megaloman (Мастер-Эксперт)
Дата отправки: 04.06.2021, 10:23 style="font-style: italic; color: gray;">нет комментария
-----
Дата оценки: 04.06.2021, 19:45

Рейтинг ответа:

НЕ одобряю 0 одобряю!

Консультация # 201077:

Здравствуйте! Прошу помощи в следующем вопросе:
При помощи датчика случайных чисел заполнить целочисленную квадратную матрицу A порядка N (N ввести с клавиатуры). Столбцы матрицы A, имеющие нечетную сумму элементов, отсортировать по убыванию элементов. Вывести сумму элементов столбцов, а также матрицу A до и после сортировки. Все элементы отсортированных столбцов выделить цветом.(Решить на языке VBA)
Заранее огромное спасибо!!!

Дата отправки: 03.06.2021, 21:55
Вопрос задал: 23071996 (Посетитель)
Всего ответов: 1
Страница онлайн-консультации »


Консультирует Megaloman (Мастер-Эксперт):


Код
Sub MatrixNN()

Const R1 = "A1"             ' Адрес ячейки с первым элементом массива чисел
Const upperbound = 9000     'Пределы изменения элементов массива
Const lowerbound = -9000

N = InputBox("Введите целое N>0")

ierr = False
If IsNumeric(N) Then
    CN = CDbl(N)
    ierr = CDbl(CN) > 0 And Int(CN) = CN
End If

If Not ierr Then
    MsgBox "Введено неверное число" + vbCrLf + N
    Exit Sub
End If

ReDim Mass(1 To N, 1 To N)

Randomize
For i = 1 To N
    For j = 1 To N
        Mass(i, j) = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    Next
Next

With Rows("1:100000")
    .ClearContents
    .Interior.Pattern = xlNone
End With

R1N = Range(R1).Offset(N - 1, N - 1).Address
Range(R1 + ":" + R1N) = Mass

R2 = Range(R1).Offset(N + 3, 0).Address
R2N = Range(R2).Offset(N - 1, N - 1).Address

For k = 1 To N
    sCol = 0
    For i = 1 To N
        sCol = sCol + Mass(i, k)
    Next
    
    Range(R1).Offset(N + 1, k - 1) = sCol
    
    If sCol Mod 2 <> 0 Then
        Range(R1).Offset(N + 1, k - 1).Interior.Color = 65535

        RR = Range(R2).Offset(0, k - 1).Address
        RRN = Range(RR).Offset(N - 1, 0).Address
        Range(RR + ":" + RRN).Interior.Color = 65535
        
        For i = 1 To N
            m1 = Mass(i, k)
            For j = i To N
                If Mass(j, k) > Mass(i, k) Then
                    Mass(i, k) = Mass(j, k)
                    Mass(j, k) = m1
                    m1 = Mass(i, k)
                End If
            Next
        Next
    End If
Next

Range(R2 + ":" + R2N) = Mass
End Sub

ya21060414.xlsm (278.5 кб)

Консультировал: Megaloman (Мастер-Эксперт)
Дата отправки: 04.06.2021, 15:35 style="font-style: italic; color: gray;">нет комментария
-----
Дата оценки: 04.06.2021, 19:45

Рейтинг ответа:

НЕ одобряю 0 одобряю!


Оценить выпуск | Задать вопрос экспертам

главная страница  |  стать участником  |  получить консультацию
техническая поддержка

Дорогой читатель!
Команда портала RFPRO.RU благодарит Вас за то, что Вы пользуетесь нашими услугами. Вы только что прочли очередной выпуск рассылки. Мы старались. Пожалуйста, оцените его. Если совет помог Вам, если Вам понравился ответ, Вы можете поблагодарить автора - для этого в каждом ответе есть специальные ссылки. Вы можете оставить отзыв о работе портале. Нам очень важно знать Ваше мнение. Вы можете поближе познакомиться с жизнью портала, посетив наш форум, почитав журнал, который издают наши эксперты. Если у Вас есть желание помочь людям, поделиться своими знаниями, Вы можете зарегистрироваться экспертом. Заходите - у нас интересно!
МЫ РАБОТАЕМ ДЛЯ ВАС!


В избранное