RFpro.ru: Пакет Microsoft Office

  Все выпуски  

RFpro.ru: Пакет Microsoft Office


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

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

Megaloman
Статус: Мастер-Эксперт
Рейтинг: 226
∙ повысить рейтинг »
CradleA
Статус: Академик
Рейтинг: 94
∙ повысить рейтинг »
Valery N
Статус: Мастер-Эксперт
Рейтинг: 2
∙ повысить рейтинг »

∙ Пакет MSOffice

Номер выпуска:1031
Дата выхода:30.03.2021, 19:15
Администратор рассылки:Megaloman (Мастер-Эксперт)
Подписчиков / экспертов:4 / 30
Вопросов / ответов:1 / 1

Консультация # 200490: Здравствуйте! Прошу помощи в следующем вопросе: Помогите написать в макросе 2 задачки. Извиняюсь что не прописываю формулой, заранее огромное спасибо...

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

Здравствуйте! Прошу помощи в следующем вопросе:
Помогите написать в макросе 2 задачки.
Извиняюсь что не прописываю формулой, заранее огромное спасибо

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


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

Здравствуйте, 23071996!

Задача 3.11
Функция задана, вычислить её значения в заданных точках не представляет труда. Однако задание требует построения касательной в заданной точке.
Получим уравнение касательной.



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

Код
Sub Job_3_1()

    Const x1 = 0, x2 = 4, xd = 0.2, x0 = 0.5
    
    Const R1 = "A1"     'Адрес левой верхней ячейки с данными
'    Const R1 = "B2"     'Адрес левой верхней ячейки с данными
    
    Dim i, Nx, x
    Dim Fx0, F1x0
    Dim R2, RRfunk
    Dim WorkSh, DiagName
    
    Nx = Round((x2 - x1) / xd, 0) + 1
    ReDim Dann(1 To Nx, 1 To 3)
    
    Fx0 = x0 * Sin(2 * x0)
    F1x0 = Sin(2 * x0) + 2 * x0 * Cos(2 * x0)
    x = x1
    For i = 1 To Nx
        Dann(i, 1) = x
        Dann(i, 2) = x * Sin(2 * x)
        Dann(i, 3) = F1x0 * (x - x0) + Fx0
        x = x1 + xd * i
    Next
    
    Sheets.Add After:=Sheets(Sheets.Count)
    
    R2 = Range(R1).Offset(Nx - 1, 2).Address
    Range(R1 + ":" + R2) = Dann
    
    RRfunk = Range(R1).Offset(0, 1).Address
    RRfunk = RRfunk + ":" + R2
    
    WorkSh = ActiveSheet.Name
    Range(RRfunk).Select
    
    ActiveSheet.Shapes.AddChart.Select
    
    With ActiveChart
        DiagName = Replace(.Name, WorkSh + " ", "")
        .ChartType = xlLine
        .SetSourceData Source:=Range("'" + WorkSh + "'!" + RRfunk)
        .PlotArea.Select
        .SeriesCollection(1).XValues = "=" + WorkSh + "!" + R1 + ":" + Range(R1).Offset(Nx - 1, 0).Address
        With .Axes(xlCategory)
            .TickLabels.NumberFormat = "# ##0.0"
            .CrossesAt = 1
            .AxisBetweenCategories = False
        End With
    End With
    
    With ActiveSheet.Shapes(DiagName)
        .ScaleWidth 1.1437, msoFalse, msoScaleFromBottomRight
        .ScaleHeight 1.366, msoFalse, msoScaleFromBottomRight
        .ScaleWidth 1.4025, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 1.085, msoFalse, msoScaleFromTopLeft
    End With
    
    Range("A1").Select
End Sub



Задача 3.12
Для оптимизации вычислений преобразуем приведенную формулу к виду:






Вот макрос, реализующий этот алгоритм:
Код
Sub Job_3_2()

Const x = 1.5
Const N = 16

Dim Fx, Yi, dY, Zi, i

Fx = 0
Yi = x
dY = x ^ 0.2
Zi = -1

For i = 1 To N
    Yi = Yi * dY
    Zi = Zi * (-0.25)
    Fx = Fx + Sin(Yi) * Zi
Next

MsgBox "x=" + CStr(x) + vbCrLf + "F(x)=" + CStr(Fx)

End Sub

Так как ничего не было сказано о способе ввода данных, значение x задаётся константой.

В прилагаемом файле ya210327.xlsm (33.6 кб) приведенные макросы, два рабочих листа с решением задач без макросов, как дополнительный контроль работы макроса, а также созданный макросом лист по задаче 3.11


Консультировал: Megaloman (Мастер-Эксперт)
Дата отправки: 27.03.2021, 01:43

5
нет комментария
-----
Дата оценки: 29.03.2021, 13:22

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

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


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

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

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


В избранное