Автоматизация работы аукциона

Set obj = Worksheets("Лот аукциона").Cells(1, 1).CurrentRegion

N = obj.Rows.Count + 1

With UserForm1

M(1) = .TextBox10.Text

M(2) = .TextBox9.Text

M(3) = .TextBox8.Text

M(4) = .ComboBox7.Text

M(5) = .ComboBox6.Text

M(6) = .ComboBox5.Text

M(7) = .TextBox7.Text

M(8) = .TextBox6.Text

M(9) = .ComboBox4.Text

End With

For i = 1 To 9

Worksheets("Лот аукциона").Cells(N, i).Value = M(i)

Next i

With UserForm1

.TextBox10.Text = " "

.TextBox9.Text = " "

.TextBox8.Text = " "

.ComboBox7.Text = " "

.ComboBox6.Text = " "

.ComboBox5.Text = " "

.TextBox7.Text = " "

.TextBox6.Text = " "

.ComboBox4.Text = " "

.TextBox1.SetFocus

End With

If Len(M(1)) = 0 Or Len(M(2)) = 0 Or Len(M(3)) = 0 Or Len(M(4)) = 0 Or Len(M(5)) = 0 Or Len(M(6)) = 0 Or Len(M(7)) = 0 Or Len(M(8)) = 0 Or Len(M(9)) = 0 Then

MsgBox "Заполните, пожалуйста, все поля!", vbCritical, Title:="Ошибка ввода"

Exit Sub

End If

End Sub

Меню «Участники аукциона»:

Private Sub CommandButton1_Click()

Dim M(1 To 3) As Variant

Dim obj As Object

Dim N As Integer, i As Integer

Set obj = Worksheets("участники аукциона").Cells(1, 1).CurrentRegion

N = obj.Rows.Count + 1

With UserForm2

M(1) = .TextBox1.Text

M(2) = .TextBox2.Text

M(3) = .ComboBox1.Text

End With

For i = 1 To 3

Worksheets("участники аукциона").Cells(N, i).Value = M(i)

Next i

With UserForm2

.TextBox1.Text = " "

.TextBox2.Text = " "

.ComboBox1.Text = " "

.TextBox1.SetFocus

End With

If Len(M(1)) = 0 Or Len(M(2)) = 0 Or Len(M(3)) = 0 Then

MsgBox "Заполните, пожалуйста, все поля!", vbCritical, Title:="Ошибка ввода"

Exit Sub

End If

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Меню «Изменение информации об участнике»:

Private Sub CommandButton1_Click()

Dim obj As Object

Dim i As Integer

i = 0

With Worksheets("Участники аукциона").Range("a1:a500")

    Set obj = .Find(ComboBox1.Text, LookIn:=xlValues)

    If Not obj Is Nothing Then

        firstAddress = obj.Address

        Do

            i = i + 1

            obj.Cells(i, 3).Value = ComboBox2.Text

            obj.Cells(i, 2).Value = TextBox1.Text

            Set obj = .FindNext(obj)

        Loop While Not obj Is Nothing And obj.Address <> firstAddress

    End If

End With

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Меню «Торги»:

Dim StrSearch As Object

Private Sub ComboBox1_Change()

Dim zapros As String

Dim o_O As Object

Dim KolStr As Integer

Dim l As Integer

zapros = UserForm4.ComboBox1.Value

KolStr = Sheets("Лот аукциона").Cells(1, 1).CurrentRegion.Rows.Count

For i = 1 To KolStr

Sheets("temp").Cells(i, 1) = " "

Next i

l = 1

For i = 2 To KolStr

If Sheets("Лот аукциона").Cells(i, 9) = zapros Then

   Sheets("temp").Cells(l, 1) = Sheets("Лот аукциона").Cells(i, 8)

   l = l + 1

   End If

Next i

KolStr = Sheets("temp").Cells(1, 1).CurrentRegion.Rows.Count

ComboBox4.List = Sheets("temp").Range("A1", Sheets("temp").Cells(KolStr, 1)).Value

End Sub

Private Sub ComboBox4_Change()

Dim Exp As String

Exp = ComboBox4.Value

Set StrSearch = Sheets("Лот аукциона").Columns(8).Find(Exp, lookat:=xlWhole)

If Not (StrSearch Is Nothing) Then

TextBox1.Text = Sheets("Лот аукциона").Cells(StrSearch.Row, 2).Value

TextBox2.Text = Sheets("Лот аукциона").Cells(StrSearch.Row, 1).Value

TextBox3.Text = Sheets("Лот аукциона").Cells(StrSearch.Row, 3).Value

TextBox4.Text = Sheets("Лот аукциона").Cells(StrSearch.Row, 5).Value

TextBox5.Text = Sheets("Лот аукциона").Cells(StrSearch.Row, 6).Value

TextBox6.Text = Sheets("Лот аукциона").Cells(StrSearch.Row, 7).Value

Else

ComboBox1.ListIndex = -1

TextBox1.Text = ""

TextBox2.Text = ""

TextBox3.Text = ""

TextBox4.Text = ""

TextBox5.Text = ""

TextBox6.Text = ""

End If

End Sub

Private Sub ComboBox3_Change()

Dim nom As String

nom = ComboBox3.Value

Set StrSearch = Sheets("участники аукциона").Columns(2).Find(nom, lookat:=xlWhole)

If Not (StrSearch Is Nothing) Then

TextBox7.Text = Sheets("участники аукциона").Cells(StrSearch.Row, 1).Value

Else

ComboBox1.ListIndex = -1

TextBox7.Text = " "

End If

End Sub

Private Sub CommandButton1_Click()

Set StrSearch = Sheets("лот аукциона").Columns(8).Find(ComboBox4.Value, lookat:=xlWhole)

Dim M(1 To 11) As Variant

Dim pro As Object

Dim N As Integer, i As Integer

Set pro = Worksheets("Архив").Cells(1, 1).CurrentRegion

N = pro.Rows.Count + 1

With UserForm4

M(1) = .ComboBox1.Text

M(2) = .ComboBox4.Text

M(3) = .TextBox1.Text

M(4) = .TextBox2.Text

M(5) = .TextBox3.Text

M(6) = .TextBox4.Text

M(7) = .TextBox5.Text

M(8) = .TextBox6.Text

M(9) = .ComboBox3.Text

M(10) = .TextBox7.Text

M(11) = .TextBox8.Text

End With

For i = 1 To 11

Worksheets("Архив").Cells(N, i).Value = M(i)

Next i

With UserForm4

.ComboBox1.Text = " "

.ComboBox4.Text = " "

.TextBox1.Text = " "

.TextBox2.Text = " "

.TextBox3.Text = " "

.TextBox4.Text = " "

.TextBox5.Text = " "

.TextBox6.Text = " "

.ComboBox3.Text = " "

.TextBox7.Text = " "

.TextBox8.Text = " "

.TextBox1.SetFocus

End With

If Len(M(1)) = 0 Or Len(M(2)) = 0 Or Len(M(3)) = 0 Or Len(M(4)) = 0 Or Len(M(5)) = 0 Or Len(M(6)) = 0 Or Len(M(7)) = 0 Or Len(M(8)) = 0 Or Len(M(9)) = 0 Or Len(M(10)) = 0 Or Len(M(11)) = 0 Then

MsgBox "Заполните, пожалуйста, все поля!", vbCritical, Title:="Ошибка ввода"

Exit Sub

End If

End Sub

Private Sub CommandButton3_Click()

Unload Me

End Sub

Меню «Удаление лота»:

Dim StrSearch As Object

Private Sub ComboBox1_Change()

Dim Exp As String

Exp = ComboBox1.Value

Set StrSearch = Sheets("лот аукциона").Columns(1).Find(Exp, lookat:=xlWhole)

If Not (StrSearch Is Nothing) Then

ComboBox1.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 1).Value

ComboBox2.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 2).Value

ComboBox3.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 3).Value

Else

ComboBox1.ListIndex = -1

ComboBox1.Text = ""

ComboBox2.Text = ""

ComboBox3.Text = ""

End If

End Sub

Private Sub CommandButton1_Click()

If Not (StrSearch Is Nothing) Then

Sheets("лот аукциона").Range(Sheets("лот аукциона").Cells(StrSearch.Row, 1), Sheets("лот аукциона").Cells(StrSearch.Row, 5)).Copy

Sheets("лот аукциона").Range(Sheets("лот аукциона").Cells(StrSearch.Row, 1), Sheets("лот аукциона").Cells(StrSearch.Row, 9)).Delete

Unload Me

Else

MsgBox "Ошибка", vbCritical

End If

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Меню «Изменение лота»:

Dim StrSearch As Object

Private Sub CommandButton1_Click()

Dim obj As Object

Dim i As Integer

i = 0

With Worksheets("лот аукциона").Range("a1:a500")

    Set obj = .Find(ComboBox1.Text, LookIn:=xlValues)

    If Not obj Is Nothing Then

        firstAddress = obj.Address

        Do

            i = i + 1

            obj.Cells(i, 2).Value = ComboBox2.Text

            obj.Cells(i, 3).Value = ComboBox3.Text

            obj.Cells(i, 4).Value = ComboBox4.Text

            obj.Cells(i, 5).Value = ComboBox5.Text

            obj.Cells(i, 6).Value = ComboBox6.Text

            obj.Cells(i, 7).Value = TextBox1.Text

            obj.Cells(i, 8).Value = TextBox2.Text

            obj.Cells(i, 9).Value = ComboBox9.Text

            Set obj = .FindNext(obj)

        Loop While Not obj Is Nothing And obj.Address <> firstAddress

    End If

End With

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Private Sub ComboBox1_Change()

Dim Exp As String

Exp = ComboBox1.Value

Set StrSearch = Sheets("лот аукциона").Columns(1).Find(Exp, lookat:=xlWhole)

If Not (StrSearch Is Nothing) Then

ComboBox1.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 1).Value

ComboBox2.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 2).Value

ComboBox3.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 3).Value

ComboBox4.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 4).Value

ComboBox5.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 5).Value

ComboBox6.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 6).Value

TextBox1.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 7).Value

TextBox2.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 8).Value

ComboBox9.Text = Sheets("лот аукциона").Cells(StrSearch.Row, 9).Value

Else

'ComboBox1.ListIndex = -1

ComboBox1.Text = ""

ComboBox2.Text = ""

ComboBox3.Text = ""

ComboBox4.Text = ""

ComboBox5.Text = ""

ComboBox6.Text = ""

TextBox1.Text = ""

TextBox2.Text = ""

ComboBox9.Text = ""

End If

End Sub

Меню «Удаление участника»:

Dim StrSearch As Object

Private Sub ComboBox1_Change()

Dim fio As String

fio = ComboBox1.Value

Set StrSearch = Sheets("участники аукциона").Columns(1).Find(fio, lookat:=xlWhole)

If Not (StrSearch Is Nothing) Then

ComboBox1.Text = Sheets("участники аукциона").Cells(StrSearch.Row, 1).Value

ComboBox2.Text = Sheets("участники аукциона").Cells(StrSearch.Row, 2).Value

ComboBox3.Text = Sheets("участники аукциона").Cells(StrSearch.Row, 3).Value

Else

ComboBox1.ListIndex = -1

ComboBox1.Text = ""

ComboBox2.Text = ""

ComboBox3.Text = ""

End If

End Sub

Private Sub CommandButton1_Click()

If Not (StrSearch Is Nothing) Then

'Sheets("участники аукциона").Range(Sheets("участники аукциона").Cells(StrSearch.Row, 1), Sheets("учатсники аукциона").Cells(StrSearch.Row, 5)).Copy

Sheets("участники аукциона").Range(Sheets("участники аукциона").Cells(StrSearch.Row, 1), Sheets("участники аукциона").Cells(StrSearch.Row, 3)).Delete

Unload Me

Else

MsgBox "Ошибка", vbCritical

End If

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Меню «Поиск»:

Private Sub CommandButton1_Click()

Dim zapros As String

Dim o_O As Object

Dim KolStr As Integer

Dim l As Integer

zapros = UserForm8.TextBox1.Value

KolStr = Sheets("Лот аукциона").Cells(1, 1).CurrentRegion.Rows.Count

For i = 1 To KolStr

    With Sheets("Найдено")

        .Cells(i, 1) = ""

        .Cells(i, 2) = ""

        .Cells(i, 3) = ""

        .Cells(i, 4) = ""

    End With

Next i

With Sheets("Найдено")

.Cells(1, 1).Value = "Название"

.Cells(1, 2).Value = "Автор"

.Cells(1, 3).Value = "Дата написания"

.Cells(1, 4).Value = "Дата аукциона"

End With

l = 2

For i = 2 To KolStr

    Set o_O = Sheets("Лот аукциона").Rows(i).Find(zapros, lookat:=xlWhole)

    If Not (o_O Is Nothing) Then

    With Sheets("Найдено")

    .Cells(l, 1) = Sheets("Лот аукциона").Cells(o_O.Row, 1).Value

    .Cells(l, 2) = Sheets("Лот аукциона").Cells(o_O.Row, 2).Value

    .Cells(l, 3) = Sheets("Лот аукциона").Cells(o_O.Row, 3).Value

    .Cells(l, 4) = Sheets("Лот аукциона").Cells(o_O.Row, 9).Value

   End With

    l = l + 1

    End If

Next i

    TextBox1.Value = ""

    Sheets("Найдено").Visible = -1

   Sheets("Найдено").Activate

   End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Меню «Отчет»:

Private Sub ComboBox1_Change()

Dim zapros As String

Dim o_O As Object

Dim KolStr As Integer

Dim l As Integer

Dim kol As Integer

Dim summ As Long

kol = 0

summ = 0

zapros = UserForm9.ComboBox1.Value

KolStr = Sheets("архив").Cells(1, 1).CurrentRegion.Rows.Count

For i = 1 To KolStr

Sheets("tempry").Cells(i, 1) = " "

Next i

l = 1

For i = 2 To KolStr

If Sheets("архив").Cells(i, 1) = zapros Then

   Sheets("tempry").Cells(l, 1) = Sheets("архив").Cells(i, 2)

      l = l + 1

   kol = kol + 1

   summ = summ + Sheets("архив").Cells(i, 11)

   End If

Next i

TextBox1.Text = kol

TextBox2.Text = summ

End Sub

Private Sub CommandButton1_Click()

Dim M(1 To 3) As Variant

Dim obj As Object

Dim N As Integer, i As Integer

Set obj = Worksheets("отчетность").Cells(1, 1).CurrentRegion

N = obj.Rows.Count + 1

With UserForm9

M(1) = .ComboBox1.Text

M(2) = .TextBox1.Text

M(3) = .TextBox2.Text

End With

For i = 1 To 3

Worksheets("отчетность").Cells(N, i).Value = M(i)

Next i

With UserForm9

.ComboBox1.Text = " "

.TextBox1.Text = " "

.TextBox2.Text = " "

'.TextBox1.SetFocus

End With

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Меню «Печать отчета»:

Private Sub CommandButton1_Click()

Sheets("Отчетность").PrintOut

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Блок-схема «Удаление участника аукциона»:

                                          ДА

                                   НЕТ   

25