| ← Май 2021 → | ||||||
|
1
|
2
|
|||||
|---|---|---|---|---|---|---|
|
3
|
4
|
5
|
6
|
7
|
8
|
9
|
|
10
|
11
|
12
|
13
|
14
|
15
|
16
|
|
18
|
19
|
20
|
21
|
22
|
23
|
|
|
24
|
25
|
26
|
27
|
28
|
29
|
30
|
|
31
|
||||||
За последние 60 дней ни разу не выходила
Сайт рассылки:
http://rusfaq.ru
Открыта:
03-03-2006
Статистика
0 за неделю
RFpro.ru: Пакет Microsoft Office
| РАССЫЛКИ ПОРТАЛА RFPRO.RU
Лучшие эксперты в разделе
Пакет MSOffice
Консультация # 200816: Здравствуйте! У меня возникли сложности с таким вопросом: Затабулировать функцию двух переменных:... Здравствуйте! У меня возникли сложности с таким вопросом:
Дата отправки: 12.05.2021, 18:40 Консультирует 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
Здравствуйте! У меня возникли сложности с таким вопросом:
Дата отправки: 12.05.2021, 18:41 Консультирует 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
Оценить выпуск | Задать вопрос экспертам
главная страница
|
стать участником
|
получить консультацию
|
| В избранное | ||
