Добавление и удаление данных с применением вкладок (VBA)

Добавление и удаление данных с применением вкладок (VBA)

Добавление и удаление данных - еще одна полезная возможность, сделать работу человека проще. Реализация подобной функции позволит безошибочно добавлять новые данные, не забыв про какой либо атрибут, т.е. добавить в таблицу строчку (например) с новым клиентом, и исключить его добавление не указав номер телефона.

Создайте два рабочих листа, назовите их «Прейскурант» и «Реализация»

Вид листа «Прейскурант»:

 

Вид листа «Реализация»:

 

Создайте UserForm следующего вида (при создании используется элемент управления Page – что позволяет создать две вкладки «Добавить» и «Удалить»).

Вид UserForm для вкладки «Добавить». Обратите внимание, что снизу под вводом цены расположена надпись (это Label4), при подведении мышки к кнопкам «Добавить» или «Отмена» в этой надписи будет появляться информация!

 

Программные коды:

Для кнопки «Добавить»:

Private Sub CommandButton1_Click()

Dim Y As Byte

If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Then

Y = MsgBox("Добавление этого товара невозможно, т.к. не введены все критерии", vbOKCancel, "Товар")

If h = vbCancel Then GoTo e Else GoTo 12

End If

Dim name As String, simvol As String

Dim pr As Object, X As Object

Dim Название As String, Символ As String

Dim Цена As Integer

‘проверка не повторяется ли код:

ActiveWorkbook.Sheets("Прейскурант").Activate

simvol = TextBox1

Set pr = ActiveSheet.Range("a1")

Do While Not IsEmpty(pr)

Set X = pr.Offset(1, 0)

If pr = simvol Then

Y = MsgBox("Добавление невозможно, т.к. введеный код уже зарегистрирован", vbOKCancel, "Код")

If Y = vbCancel Then GoTo e Else GoTo 12

End If

Set pr = X

Loop

‘ проверка не вводится ли повторяющееся наименование товара:

ActiveWorkbook.Sheets("Прейскурант").Activate

name = TextBox2

Set pr = ActiveSheet.Range("b2")

Do While Not IsEmpty(pr)

Set X = pr.Offset(1, 0)

If pr = name Then

Y = MsgBox("Такой товар уже есть в списке, внести его еще под другим кодом?", vbYesNo + vbQuestion, "Товар")

If Y = vbYes Or Y = vbNo Then GoTo 5 Else GoTo 12

End If

Set pr = X

Loop

5 Символ = TextBox1

Название = TextBox2

Цена = TextBox3

ActiveWorkbook.Sheets("Прейскурант").Activate

'поиск пустой строки, в которую будут добавлены данные

 

Range("A3").Select

Selection.EntireRow.Insert

Set pr = ActiveSheet.Range("A2")

Do While Not IsEmpty(pr)

Set X = pr.Offset(1, 0)

Set pr = X

Loop

pr = Символ

pr.Offset(0, 1) = Название

pr.Offset(0, 2) = Цена

Set pr = Nothing

Set X = Nothing

'сортировка

 

Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

12 UserForm1.Hide

e: End Sub

 

Программные коды для «всплывающей» надписи:

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Label4.Caption = "Добавить в список набранный товар"

End Sub

 

Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Label4.Caption = "Сброс набранной информации"

End Sub

 

Программный код для кнопки «Сброс»:

Private Sub CommandButton2_Click()

TextBox1 = ""

TextBox2 = ""

TextBox3 = ""

End Sub

Проверка для ввода только числовых данных:

' Обработка нажатия клавиш - не позволяет вводить другие символы, кроме цифр

Private Sub textbox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then

Beep

KeyAscii = 0

End If

End Sub

 

При удалении данных будет автоматически выходить название товара. Удаление будет производиться сразу в двух таблицах: на листе «прейскурант» и на листе «Реализация».

UserForm (вкладка «Удалить») выгладит следующим образом:

 

Программный код для кнопки «Удалить»:

Private Sub CommandButton3_Click()

Dim pr As Object, X As Object

Dim name As String

Dim h As Byte

Dim Y As Byte

h = MsgBox("Вы действительно хотите удалить этот товар?", vbYesNo + vbQuestion, "Удаление")

If h = vbYes Then Else GoTo e

name = ComboBox1

If ComboBox1 = "" Then

Y = MsgBox("Удаление невозможно, т.к. не выделен объект", vbYes + vbQuestion, "Удаление")

If Y = vbYes Then GoTo 12 Else GoTo e

End If

ActiveWorkbook.Sheets("Реализация").Activate

Set pr = ActiveSheet.Range("b2")

Do While Not IsEmpty(pr)

Set X = pr.Offset(1, 0)

If pr = name Then

pr.Select

Selection.EntireRow.Delete

End If

Set pr = X

Loop

ActiveWorkbook.Sheets("Прейскурант").Activate

Set pr = ActiveSheet.Range("a2")

Do While Not IsEmpty(pr)

Set X = pr.Offset(1, 0)

If pr = name Then

pr.Select

Selection.EntireRow.Delete

End If

Set pr = X

Loop

12 ComboBox1 = ""

Label7 = ""

UserForm1.Hide

e: End Sub

 

программный код для активации формы:

Private Sub UserForm_activate()

Dim pr As Object, X As Object

UserForm1.ComboBox1.Clear

ActiveWorkbook.Sheets("Прейскурант").Select

Set pr = ActiveSheet.Range("a2")

Do While Not IsEmpty(pr)

Set X = pr.Offset(1, 0)

ComboBox1.AddItem pr

Set pr = X

Loop

End Sub

 

Оставьте комментарий!

grin LOL cheese smile wink smirk rolleyes confused surprised big surprise tongue laugh tongue rolleye tongue wink raspberry blank stare long face ohh grrr gulp oh oh downer red face sick shut eye hmmm mad angry zipper kiss shock cool smile cool smirk cool grin cool hmm cool mad cool cheese vampire snake excaim question

Комментарий будет опубликован после проверки

(обязательно)