Sub Mat2Sred()

    Const n As Integer = 20                 ' Размерность матрицы X - кол-во строк
    Const m As Integer = 10         
       ' Размерность матрицы X - кол-во столбцов
    Const loX = -20                         ' Минимум значения элемента в матрице X
    Const upX = 20                          ' Максимум значения элемента в матрице X
    
    Const k As Integer = 3                  ' Размерность матрицы Y - кол-во строк
    Const l As Integer = 2                  ' Размерность матрицы Y - кол-во столбцов
    Const loY = -10                         
 9; Минимум значения элемента в матрице Y
    Const upY = 5                           ' Максимум значения элемента в матрице Y
    
    ReDim X(n - 1, m - 1) As Integer        ' Описание массивов указанной размерности
    ReDim Y(k - 1, l - 1) As Integer
    
    Call MatRand(X, n, m, loX, upX)         ' Заполняем матрицы случайными числами в указанном диапазоне
    Call MatRand(Y, k, l, loY, upY)         ' Заполняем матрицы случайными числами в указанном диапазоне
  
 
    Range("A1:IV65000").ClearContents       ' Вывод в задании не оговорен, вывожу результаты на текущий лист таблицы
    Call OutMass(X, n, m, 0, 3)
    Call OutMass(Y, k, l, n + 2, 3)
    
    Mes = "Среднее значение матрицы X=" + CStr(MatSred(X, n, m)) + vbCrLf + vbCrLf     ' Формируем текст ответа. Среднее значение вычисляется функцией MatSred
    Mes = Mes + "Среднее значение матрицы Y=" + CStr(MatSred(Y, k, l))
 
    
    MsgBox Mes

End Sub

' подпрограмма заполняет матрицу MM(n,m)случайными целыми числами в указанном диапазоне от lo до up
Sub MatRand(MM, n, m, lo, up)
    Randomize
    For i = 0 To n - 1                          ' Заполняем матрицы случайными числами в указанном диапазоне
        For j = 0 To m - 1
            MM(i, j) = Int(Round((up - lo + 1) * Rnd + lo, 0))
        Next
    Next
End Sub

' функция ищет среднее арифметическое всех элементов
матрицы
Function MatSred(MM, n, m)
    S = 0
    For i = 0 To n - 1                          ' Ищем сумму всех элементов матрицы
        For j = 0 To m - 1
            S = S + MM(i, j)
        Next
    Next
    MatSred = CSng(S) / CSng(n * m)
End Function

' Вывод матрицы в таблицу
Sub OutMass(MM, n, m, D1, D2)
' Вывод в задании не оговорен, вывожу на текущий лист таблицы
    Range("A1").Select
    Fo
 r i = 0 To n - 1
        For j = 0 To m - 1
            Range("A1").Offset(i + D1, j + D2) = MM(i, j)
        Next
    Next
    
End Sub

Sub Z178930()
    Const FileNameIn = "E:\Delete\PallMall.txt"
    
    NFileIn = FreeFile                      ' Определяем ссылочный номер Входного
файла
    Open FileNameIn For Input As #NFileIn   ' Открываем входной файл
     
      MaxWord = ""
      NStr = 0
      NStrMax = 0
      MaxLen = 0
 
    Do While Not EOF(NFileIn)                   ' Loop until end of file.
      Line Input #NFileIn, Dann                 ' Читаем построчно текстовый файл со словами
      NStr = NStr + 1                           ' Подсчитываем номер строки
      
     
  Do While InStr(1, Dann, "  ") > 0         ' Оставляем между слов не более 1 пробела
            Dann = Replace(Dann, "  ", " ")
      Loop
      
      If Len(Dann) > 0 Then                     ' Если строка не пустая
      
        Mass = Split(Dann, " ")                   ' Экспортируем прочитанную строку в массив. Резделитель - пробелы
      
        For i = 0 To UBound(Mass)                   ' Обрабатываем каждое слово
в массиве, формируем новую строку
            If Len(Mass(i)) > MaxLen Then           ' Ищем самое длинное слово
                MaxLen = Len(Mass(i))               ' Запоминаем его длину
                MaxWord = Mass(i)                   ' Запоминаем слово
                NStrMax = NStr                      ' Запоминаем строку
            End If
        Next
      End If
    Loop
    
    Close #NFileIn                 
                      ' Закрываем файл
    
    Msg = "В файле" + vbCrLf + FileNameIn + vbCrLf      ' Формирую текст ответа
    Msg = Msg + vbCrLf + "в строке " + CStr(NStrMax) + vbCrLf
    Msg = Msg + "слово максимальной длины " + CStr(MaxLen) + " символов" + vbCrLf
    Msg = Msg + vbCrLf + MaxWord
        
    MsgBox Msg                                          ' Выдаю ответ

End Sub

Sub Matr3()
    
    Const N As Integer = 16             ' Размерность матриц
    Const lowerbound As Integer = -20            ' Минимум значения элемента в матрице
    Const upperbound As Integer = 20             ' Максимум значения элемента в 
 матрице
    
    Randomize
    
    ReDim A(N - 1, N - 1) As Integer
    ReDim B(N - 1, N - 1) As Integer
    ReDim C(N - 1, N - 1) As Integer
    
    For i = 0 To N - 1                          ' Заполняем матрицы случайными числами в указанном диапазоне
        For j = 0 To N - 1
            A(i, j) = Int(Round((upperbound - lowerbound + 1) * Rnd + lowerbound))
            B(i, j) = Int(Round((upperbound - lowerbound + 1) * Rnd + lowerbound))
            C(i, j) =
Int(Round((upperbound - lowerbound + 1) * Rnd + lowerbound))
' Для отладки можно убрать комментарии так как при случайном заполнении матриц получить одинаковые нереально
            ' B(i, j) = A(i, j)
            ' C(i, j) = A(i, j)
            ' C(i, j) = B(i, j)
        Next
    Next
    
    Range("A1:IV65000").ClearContents     ' Вывод в задании не оговорен, вывожу результаты на текущий лист таблицы
    Call Out
 Mass(A, N, N, 0, 3)
    Call OutMass(B, N, N, N + 2, 3)
    Call OutMass(C, N, N, 2 * N + 4, 3)
    
    ' Будем сравнивать попарно элементы матриц
    L_AB = True
    L_AC = True
    L_BC = True
    
    For i = 0 To N - 1                          ' Сравниваем попарно элементы 3 матриц, результат сравнения в логических переменных
        For j = 0 To N - 1
            If L_AB Then L_AB = (A(i, j) = B(i, j))
            If L_AC Then L_AC = (A(i, j) = C(i, j))

           If L_BC Then L_BC = (B(i, j) = C(i, j))
        Next
        If Not L_AB And Not L_AC And Not L_BC Then Exit For  ' Если расхождения обнаружены во всех трёх матрицах, то выходим из цикла анализа
    Next
    
    Y = 0                       ' Смотрим, сколько условий равенства выполнилось
    If L_AB Then Y = Y + 1
    If L_AC Then Y = Y + 1
    If L_BC Then Y = Y + 1
    
    If Y = 3 Then Y = 2         ' Если совпадают
  все матрицы, Y=2
    
    If Y = 0 Then Call MsgBox("Y=0;    Все матрицы разные")
    If Y = 1 Then Call MsgBox("Y=1;    Две матрицы одинаковые")
    If Y = 2 Then Call MsgBox("Y=2;    Все 3 матрицы одинаковые")

End Sub

' Вывод матрицы в таблицу
Sub OutMass(MM, N, M, D1, D2)
' Вывод в задании не оговорен, вывожу на текущий лист таблицы
    Range("A1").Select
    For i = 0 To N - 1
        For j = 0 To M - 1
       
    Range("A1").Offset(i + D1, j + D2) = MM(i, j)
        Next
    Next
    
End Sub

Sub Z178933()

Const Diapaz = 100000               ' Диапазон определения значений элементов массива от -... до + ...
Const FileIn = "D:\FileIn.txt"
     ' Файл с сгенерированным массивом
Const FileOut = "D:\FileOut.txt"    ' Файл с отсортированным массивом

Dim N As Long                       ' Число элементов массива
N = CDbl(InputBox("Введите число элементов в массиве" + vbCrLf + "(целое, больше нуля)"))

ReDim Mass(N - 1) As Double                         ' Описание массива

NFileIn = FreeFile                                  ' Опр
 еделяем ссылочный номер исходного сгенерированного файла
Open FileIn For Output As #NFileIn                  ' Открываем файл

SS = ""
Randomize                                           ' Initialize random-number generator.
For i = 0 To N - 1                                  ' Заполняем исходный массив случайными числами
    Mass(i) = (Diapaz + Diapaz + 1) * Rnd - Diapaz  ' Generate random value between 0 and 1000.
    Print #NFileIn, Format(Mass(i), "# ###
##0.0")  ' Записываем элемент массива в строковом виде
    SS = SS + Format(Mass(i), "# ### ##0.0") + vbCrLf
Next
Close #NFileIn                                      ' Закрываем файл
MsgBox SS, vbOKOnly, "Исходный массив"              ' Выдача массивов на экран

MMas = Mass(0)                                      ' Ищем максимальный по абсолют величине элемент
For i = 0 To N - 1
    If MMas < Abs(Mass(i
 )) Then MMas = Abs(Mass(i))
Next

NFileOut = FreeFile                                 ' Определяем ссылочный номер выходного отсортированного файла
Open FileOut For Output As #NFileOut                ' Открываем файл

If MMas <> 0 Then
    SS = ""
    For i = 0 To N - 1                                  ' Нормируем массив на макс по абс величине элемент
        Mass(i) = Mass(i) / MMas
        Print #NFileOut, Format(Mass(i), "#0.000 000 000")
 ' Записываем элемент массива в строковом виде
        SS = SS + Format(Mass(i), "#0.000 000 000") + vbCrLf
    Next
End If

Close #NFileOut
MsgBox "Делитель=" + Format(MMas, "# ### ##0.0") + vbCrLf + vbCrLf + SS, vbOKOnly, "Отнормированный массив"      ' Выдача массивов на экран

End Sub

   Const FileNameIn = "E:\Delete\PallMall.txt"     ' Исходный текстовый файл
    Const SLet = "а"                                '
Ищем строки с буквой
    Const NLit = 2                                  ' которая встречается указ число раз
    
    NFileIn = FreeFile                              ' Определяем ссылочный номер Входного файла
    Open FileNameIn For Input As #NFileIn           ' Открываем входной файл
     
    NStr = 0
    Msg = ""
    SLit = SLet
    
    Do While Not EOF(NFileIn)                   ' Loop until end of file.
 
      Line Input #NFileIn, Dann                 ' Читаем построчно текстовый файл со словами
      NStr = NStr + 1                           ' Подсчитываем номер строки
      
      Do While InStr(1, Dann, "  ") > 0         ' Оставляем между слов не более 1 пробела
            Dann = Replace(Dann, "  ", " ")
      Loop
      Dann = Trim(Dann)                        ' Убираем Начальные и конечные пробелы в строке
      
      If Len(Dann)
> 0 Then                     ' Если строка не пустая
        Dann = LCase(Dann)                      ' Если результат не должен зависеть от регистра буквы
        SLit = LCase(SLit)                      '       преобразуем строки к одному регистру
        
        If Len(Dann) - Len(Replace(Dann, SLit, "")) = NLit Then 'Убираем искомые буквы, сравниваем длины исходной иобработанной строк
        
            Mass = Split(Dan
 n, " ")                     ' Экспортируем прочитанную строку в массив. Резделитель - пробелы
            NWord = UBound(Mass) + 1                    ' Число слов в строке = числу элементов в массиве
            Msg = Msg + "Строка " + CStr(NStr) + "  Кол-во слов " + CStr(NWord) + vbCrLf   ' Формирую ответ
            
        End If
      End If
    
    Loop
    
    Close #NFileIn                                      ' Закрываем файл

   
    If Msg <> "" Then
        Msg = "В файле: " + FileNameIn + vbCrLf + Msg    ' Формирую текст ответа
    Else
        Msg = "В файле: " + FileNameIn + vbCrLf + "Нет строк с " + CStr(NLit) + " буквами " + SLit  ' Формирую текст ответа
    End If
        
    MsgBox Msg, vbOKOnly, "Строки с " + CStr(NLit) + " буквами " + SLit      ' Выдаю ответ

Ответ отправил: Megaloman, Профессионал
Ответ отправлен: 06.06.2010, 13:03
Номер ответа: 261924

Оценка ответа: 5

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

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

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

Зравствуйте. Еще одна однокурснитца нуждается в вашей помощи ))

1. В ЭВМ поступают результаты соревнований по плаванию; для трех спортсменов составить программу, которая выбирает лучший результат и выводит его на экран с сообщением о том, что это результат победителя заплыва.

Есть некоторые правила к выполнению:
1. В работе необходимо выполнить алгоритмические задачи с использованием базовых типов данных и основных операторов языка программирования VBA.
2. Темы задач: простые вычислительные алгоритмы, работа с переменными типа строка, работа с одномерным массивом, работа с двумерным массивом, работа с переменными типа запись.
3. Задачи на проверку представить в виде файлов Word либо Excel, с кодом программы, выполненном в среде VBA соответствующего компонента Office (желательно в Excel) .
4. В программах обязательно наличие комментариев, поясняющих основные алгоритмические шаги.

Отправлен: 05.06.2010, 21:46
Вопрос задал: Ананьев Рудольф Олегович, 4-й класс
Всего ответов: 1
Страница вопроса »

Ответ отправил: Andrew Kovalchuk, Студент
Ответ отправлен: 08.06.2010, 14:36
Номер ответа: 261995

Оценка ответа: 5

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

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

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

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

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