RFpro.ru: Пакет Microsoft Office

  Все выпуски  

RFpro.ru: Пакет Microsoft Office


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

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

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

Пакет MSOffice

Номер выпуска:1034
Дата выхода:17.05.2021, 18:45
Администратор рассылки:Megaloman (Мастер-Эксперт)
Подписчиков / экспертов:3 / 30
Вопросов / ответов:2 / 2

Консультация # 200815: Здравствуйте! У меня возникли сложности с таким вопросом: Написать программу для вычисления функции: Заранее огромное спасибо, прилагаю изображение...
Консультация # 200816: Здравствуйте! У меня возникли сложности с таким вопросом: Затабулировать функцию двух переменных:...

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

Здравствуйте! У меня возникли сложности с таким вопросом:
Написать программу для вычисления функции:
Заранее огромное спасибо, прилагаю изображение

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


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

Код
Sub Pgm()
    Const Rbegin = "B2"
    Const N = 100
    
    ReDim Y(N, 1)
    
    Dim ab, a_b, L2, Delta
    ab = InputBox("Введите значения интервала a b" + vbCrLf + vbCrLf + "(образец приведен)", "Ввод данных", "-1,2   7,2")
    
    If Len(ab) = 0 Then Exit Sub
    
    a_b = Split(Replace(ab, ".", ","), " ")
    L2 = UBound(a_b)
    
    If L2 < 1 Then
        MsgBox "Интервал не введен" + vbCrLf + vbCrLf + """" + ab + """"
        Exit Sub
    End If
    
    If Not IsNumeric(a_b(0)) Or Not IsNumeric(a_b(L2)) Then
        MsgBox "Значения интервала не корректны" + vbCrLf + vbCrLf + """" + a_b(0) + """   """ + a_b(L2) + """"
        Exit Sub
    End If
    
    a_b(0) = CDbl(a_b(0))
    a_b(L2) = CDbl(a_b(L2))
    Delta = (CDbl(a_b(L2)) - CDbl(a_b(0))) / N
    
    For i = 0 To N
        Y(i, 0) = a_b(0) + Delta * i
        Y(i, 1) = Func(a_b(0) + Delta * i)
    Next

    Sheets.Add After:=Sheets(Sheets.Count)
    Range(Rbegin + ":" + Range(Rbegin).Offset(N, 1).Address) = Y
    
    Dim NameList, Rdann, Rarg
    NameList = ActiveSheet.Name
    
    Rarg = Range(Rbegin).Offset(0, 0).Address + ":" + Range(Rbegin).Offset(N, 0).Address
    Rdann = Range(Rbegin).Offset(0, 1).Address + ":" + Range(Rbegin).Offset(N, 1).Address

    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range(NameList + "!" + Rdann)
    
    ShapeName = ActiveSheet.Shapes(1).Name
    
    With ActiveSheet.Shapes(ShapeName)
        .ScaleWidth 1.3, msoFalse, msoScaleFromBottomRight
        .ScaleHeight 1.2, msoFalse, msoScaleFromBottomRight
        .ScaleWidth 1.3, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
    End With
    
    With ActiveChart
        With .Axes(xlCategory)
            .Select
            .TickMarkSpacing = 5
            .TickLabelSpacing = 5
            .AxisBetweenCategories = False
            .CrossesAt = 1
            .HasMajorGridlines = True
        End With
        .PlotArea.Select
        .SeriesCollection(1).XValues = "=" + NameList + "!" + Rarg
    End With
    Range(Rarg).NumberFormat = "0.00"
    Range("A1").Select
End Sub

Function Func(x)
    If x < -1 Then Func = 0
    If -1 <= x And x < 0 Then Func = Cos(x * 3.14159265358979)
    If 0 <= x And x < 2 Then Func = x ^ 2 + 1
    If 2 <= x And x < 7 Then Func = 7 - x
    If x >= 7 Then Func = 0
End Function
Макрос создает в книге новый лист, на нём размещает массив с результатом табулирования функции и строит график. Границы интервала вычисления функции вводятся.

Консультировал: Megaloman (Мастер-Эксперт)
Дата отправки: 13.05.2021, 16:26 style="font-style: italic; color: gray;">нет комментария
-----
Дата оценки: 14.05.2021, 21:28

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

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

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

Здравствуйте! У меня возникли сложности с таким вопросом:
Затабулировать функцию двух переменных:

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


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

Вот решение без привлечения макросов:


После уточнения Вами вопроса я вынужден дополнить первоначальный ответ:

Код
Sub TabFunc()

Const Rbegin = "B4"
Const xBegin = 0, xEnd = 1, xStep = 0.1
Const yBegin = 0, yEnd = 1, yStep = 0.1
Const argMax = 1

Dim Rxy, arg
Dim Nx, Ny, i, j, x
Nx = Round((xEnd - xBegin) / xStep + 1, 0)
Ny = Round((yEnd - yBegin) / yStep + 1, 0)

ReDim MasOut(Nx, Ny)

MasOut(0, 0) = ""
For i = 1 To Nx
    MasOut(i, 0) = xBegin + xStep * (i - 1)
Next

For j = 1 To Ny
    MasOut(0, j) = yBegin + yStep * (j - 1)
Next

For i = 1 To Nx
    x = xBegin + xStep * (i - 1)
    For j = 1 To Ny
        arg = x ^ 2 + (yBegin + yStep * (j - 1)) ^ 2
        If arg <= argMax Then MasOut(i, j) = Atn(arg / (Sqr(1 - arg ^ 2) + 0.000000000000001)) Else MasOut(i, j) = "?? ???."
    Next
Next

Sheets.Add After:=Sheets(Sheets.Count)
Range(Rbegin + ":" + Range(Rbegin).Offset(Nx, Ny).Address) = MasOut

End Sub
Макрос создает в книге новый лист и на нём размещает массив с результатом табулирования функции.
Форматирование результатов не ставилось целью задания, поэтому макросом не делалось.

Ответ отредактирован модератором Megaloman (Мастер-Эксперт) 12.05.2021, 22:12

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

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

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


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

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

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


В избранное