Пузырьковая сортировка

Граф

Проверка скобок

Проверка скобок

Private Sub CommandButton1_Click()

Dim A As String, Otkr As String, Zakr As String, X As String, Y As String

Dim Ot As Integer, Za As Integer

Dim I As Integer, L As Integer, TS As Integer, ST() As String

Otkr = "([{<": Zakr = ")]}>"

A = InputBox("Введите выражение со скобками " + Otkr + Zakr, "Проверка скобок")

L = Len(A): ReDim ST(L): TS = 0 'Инициализация стека

'--------------------------------------------------------------------

For I = 1 To L: X = Mid(A, I, 1): Ot = InStr(Otkr, X)

If Ot <> 0 Then TS = TS + 1: ST(TS) = X: GoTo cont '(--> стек

Za = InStr(Zakr, X): If Za = 0 Then GoTo cont 'это не)

If TS = 0 Then MsgBox "Закрывающих скобок больше",, "Проверка скобок": Exit Sub

Y = ST(TS): TS = TS - 1 'стек --> (

Ot = InStr(Otkr, Y)

If Za <> Ot Then MsgBox "Несоответствие типов скобок",, "Проверка скобок": Exit Sub

cont:

Next I

'----------------------------------------------------------------------------

If TS = 0 Then

MsgBox "Скобки расставлены верно",, "Проверка скобок"

Else

MsgBox "Открывающих скобок больше",, "Проверка скобок"

End If

'-----------------------------------------------------------------------------

End Sub

Private Sub CommandButton1_Click()

Dim A As String, Otkr As String, Zakr As String, X As String, Y As String

Dim Ot As Integer, Za As Integer

Dim I As Integer, L As Integer, TS As Integer, ST() As String

Otkr = "([{<": Zakr = ")]}>"

A = InputBox("Введите выражение со скобками " + Otkr + Zakr, "Проверка скобок")

L = Len(A): ReDim ST(L): TS = 0 'Инициализация стека

'--------------------------------------------------------------------

For I = 1 To L: X = Mid(A, I, 1): Ot = InStr(Otkr, X)

If Ot <> 0 Then TS = TS + 1: ST(TS) = X: GoTo cont '(--> стек

Za = InStr(Zakr, X): If Za = 0 Then GoTo cont 'это не)

If TS = 0 Then MsgBox "Закрывающих скобок больше",, "Проверка скобок": Exit Sub

Y = ST(TS): TS = TS - 1 'стек --> (

Ot = InStr(Otkr, Y)

If Za <> Ot Then MsgBox "Несоответствие типов скобок",, "Проверка скобок": Exit Sub

cont:

Next I

'----------------------------------------------------------------------------

If TS = 0 Then

MsgBox "Скобки расставлены верно",, "Проверка скобок"

Else

MsgBox "Открывающих скобок больше",, "Проверка скобок"

End If

'-----------------------------------------------------------------------------

End Sub

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

Dim n As Integer, i As Integer, j As Integer, count As Integer

Range("B4:B104").ClearContents

n = Cells(2, 1)

ReDim A(n, n) As Integer

For i = 1 To n: For j = 1 To n: A(i, j) = Cells(1 + i, 2 + j): Next j, i

i = Cells(2, 2): count = 0

Call spisok(n, i, count, A())

End Sub

Sub spisok(n As Integer, i_start As Integer, count As Integer, A() As Integer)

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

For j = 1 To n

If A(i_start, j) = 1 Then

count = count + 1

Cells(3 + count, 2) = j

For k = 1 To n: A(k, j) = -Abs(A(k, j)): Next k

Call spisok(n, j, count, A())

End If

Next j

End Sub

Задача о Ханойских башнях

Public Sub swap(a As Variant, b As Variant)

Dim c As Variant

c = a

a = b

b = c

End Sub

Public Sub hanoy(n As Long, count As Long, a As String, b As String, c As String)

If n = 0 Then Exit Sub

Call hanoy(n - 1, count, a, c, b) 'Шаг 1

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

count = count + 1

Cells(1 + count, 4) = count

Cells(1 + count, 5) = a

Cells(1 + count, 6) = c

Cells(1 + count, 7) = n

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

Call hanoy(n - 1, count, b, a, c)

End Sub

Задача о Ханойских башнях

Private Sub CommandButton1_Click()

Dim a As Variant, b As Variant

a = Cells(1, 1): b = Cells(1, 2)

Call swap(a, b)

Cells(1, 1) = a: Cells(1, 2) = b

End Sub

Private Sub CommandButton2_Click()

Dim a As String, b As String, c As String

a = "A": b = "B": c = "C"

Dim n As Long, count As Long

n = Cells(1, 3)

count = 0

Call hanoy(n, count, a, b, c)

End Sub

Задача о Ханойских башнях

Private Sub CommandButton2_Click()

Dim a As String, b As String, c As String

a = "A": b = "B": c = "C"

Dim n As Long, count As Long

n = Cells(1, 3)

count = 0

Call hanoy(n, count, a, b, c)

End Sub

Public Sub hanoy(n As Long, count As Long, _

a As String, b As String, c As String)

If n = 0 Then Exit Sub

Call hanoy(n - 1, count, a, c, b) 'Шаг 1

'==================================== Шаг 2 (перенос диска n)

count = count + 1

Cells(1 + count, 4) = count

Cells(1 + count, 5) = a

Cells(1 + count, 6) = c

Cells(1 + count, 7) = n

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

Call hanoy(n - 1, count, b, a, c) 'Шаг 3

End Sub

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

Dim n As Integer, i As Integer, n1 As Integer

Dim x_temp As Integer

Dim Key_sort As Integer

n = Cells(2, 1): n1 = n

ReDim x(n) As Integer

For i = 1 To n

x(i) = Int(100 * Rnd)

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

Next i

PuzSort:

Key_sort = 0

For i = 1 To n1 - 1

If x(i) > x(i + 1) Then

Key_sort = 1

'swap x(i),x(i+1)

x_temp = x(i): x(i) = x(i + 1): x(i + 1) = x_temp

End If

Next i

For i = 1 To n: Cells(1 + i, (n - n1) + 3) = x(i): Next i

If Key_sort = 1 Then n1 = n1 - 1: GoTo PuzSort

End Sub

Дата добавления: 2014-01-05