Поиск минимального и максимального элементов

НОД

Движение брошенного под углом тела с учетом силы тяжести

Поиск повторяющихся элементов

Простейшая кинетика

Private Sub CommandButton1_Click()

Dim CA As Double

Dim CB As Double

Dim CA0 As Double

Dim CB0 As Double

Dim K1 As Double

Dim K2 As Double

Dim T As Double 'Время

Dim TT As Double 'Длина временного интервала

Dim dT As Double 'Шаг по времени

Dim dCA As Double 'Приращение концентрации CA за время dT

Dim count As Integer 'Счетчик строк в таблице концентраций

K1 = Cells(18, 2)

K2 = Cells(18, 3)

dT = Cells(18, 6)

TT = Cells(18, 7)

T = 0 'Начало отсчета времени

CA0 = Cells(18, 4) 'Начальная концентрация вещества A

CB0 = Cells(18, 5) 'Начальная концентрация вещества B

count = 1

CA = CA0

CB = CB0

Do While T <= TT

Cells(22 + count, 1) = T

Cells(22 + count, 2) = CA

Cells(22 + count, 3) = CB

dCA = (-K1 * CA + K2 * (CB0 + 2 * (CA0 - CA))) * dT

CA = CA + dCA

CB = CB - 2 * dCA

T = T + dT

count = count + 1

'Debug.Print count; dCA; K1; CA; K2; CB

Loop

End Sub

Private Sub CommandButton1_Click()

Dim i As Integer, j As Integer, k As Integer, n As Integer

Dim A() As Integer

n = 20

ReDim A(n)

For i = 1 To n

A(i) = Int(100 * Rnd)

Cells(i, 1) = A(i)

Next i

'=====================================

Range("c1:d20").ClearContents

Dim T() As Integer, L() As Integer, R() As Integer, Count() As Integer

Dim uk As Integer, TT As Integer

ReDim T(n), L(n), R(n), Count(n)

T(1) = A(1): k = 1 'Инициализация Дерева

Cells(1, 3) = A(1): Cells(1, 4) = 1

For i = 2 To n: TT = 1 'Перебор и проверка исходных чисел

check:

If A(i) = T(TT) Then

Debug.Print A(i)

Count(TT) = Count(TT) + 1: Cells(TT, 4) = Count(TT)

GoTo Skip 'Найден двойник !

End If

If A(i) < T(TT) Then GoTo Left 'К левому поддереву

'A(I)>T(TT), значит идем по правому поддереву

uk = R(TT)

If uk = 0 Then

k = k + 1: R(TT) = k: T(k) = A(i): Count(k) = 1: Cells(k, 3) = A(i): Cells(k, 4) = 1

GoTo Skip 'Новый правый сын !

Else

TT = uk: GoTo check

End If

Left:

'A(I)<T(TT), значит идем по левому поддереву

uk = L(TT)

If uk = 0 Then

k = k + 1: L(TT) = k: T(k) = A(i): Count(k) = 1: Cells(k, 3) = A(i): Cells(k, 4) = 1

GoTo Skip 'Новый левый сын !

Else

150 TT = uk: GoTo check

End If

Skip:

Next i

End Sub

Sub Кнопка1_Щелчок()

Dim v As Double, alpha As Double, m As Double

Dim a As Double, b As Double, c As Double, dt As Double

Dim t As Double, x As Double, y As Double

Dim vx As Double, vy As Double, ax As Double, ay As Double

Dim Ftr As Double, S_alpha, C_alpha

Dim count As Integer

Const g = 9.81

Const Pi = 3.14159265358979

Range("A4:H1000").ClearContents

v = Cells(2, 1)

alpha = Cells(2, 2) * Pi / 180: S_alpha = Sin(alpha): C_alpha = Cos(alpha)

m = Cells(2, 3)

a = Cells(2, 4): b = Cells(2, 5): c = Cells(2, 6)

dt = Cells(2, 7)

t = 0: count = 0: x = 0: y = 0

vx = v * Cos(alpha): vy = v * Sin(alpha)

povtor:

Ftr = a * v ^ 2 + b * v + c: Cells(4 + count, 8) = Ftr

ax = -Sgn(vx) * Ftr * C_alpha / m: ay = -g - Sgn(vy) * Ftr * S_alpha / m

Cells(4 + count, 1) = t

Cells(4 + count, 2) = x

Cells(4 + count, 3) = y

Cells(4 + count, 4) = vx

Cells(4 + count, 5) = vy

Cells(4 + count, 6) = ax

Cells(4 + count, 7) = ay

count = count + 1

t = t + dt: Cells(2, 8) = t

vx = vx + ax * dt: vy = vy + ay * dt

v = Sqr(vx ^ 2 + vy ^ 2): S_alpha = vy / v: C_alpha = vx / v

x = x + vx * dt: y = y + vy * dt

If y > o Then GoTo povtor

End Sub

Private Sub CommandButton1_Click()

Dim a As Long, b As Long, c As Long

a = Cells(1, 1)

b = Cells(1, 2)

c = Nod(a, b)

Cells(1, 3) = c

MsgBox "Ok"

Range("A1:C1").ClearContents

End Sub

Public Function Nod(a As Long, b As Long) As Long

Dim r As Long

If b > a Then r = a: a = b: b = r

r = a Mod b

If r <> 0 Then Nod = Nod(b, r) Else Nod = b

End Function

Sub Кнопка1_Щелчок()

Dim n As Integer, i As Integer

Dim i_min As Integer, i_max As Integer

Dim x_min As Integer, x_max As Integer

n = Cells(2, 1)

ReDim x(n) As Integer

For i = 1 To n

x(i) = Int(100 * Rnd)

Cells(1 + i, 2) = x(i)

Next i

i_max = 1: x_max = x(1)

i_min = 1: x_min = x(1)

For i = 2 To n

If x(i) > x_max Then x_max = x(i): i_max = i

If x(i) < x_min Then x_min = x(i): i_min = i

Cells(2, 3) = i_max: Cells(2, 4) = x_max

Cells(2, 5) = i_min: Cells(2, 6) = x_min

Next i

End Sub