Страницы: 1
RSS
Макрос для внесения данных на разные листы и в разные таблицы, Помощь в составлении правильного макроса
 
Друзья, всем привет! Прошу помощи!!!!
Попробую описать суть проблемы: Для технологов нужен файл в который будут вноситься данные о модели насоса, годе изготовления, месяц изготовления и причин поломки насосов. Это необходимо для выявления причин брака на производстве! Вложенный файл почти сделан (желательно в котором поправить макрос), но не могу додумать, как заставить код вписать в определенную таблицу данные.
Макрос, который сейчас используется находится на кнопке в форме под названием "Добавить данные". Очень будет удобно если в макросе при выборе всех параметров он записывал информацию в нужную ячейку и в нужную таблицу, чтобы потом формулы сами посчитали процент брака и рисовался график брака.
Спасибо всем тем, кто откликнется!))))
С уважением, Ершов Павел


 
Вот сам код, который вносит данные из формы, но он почему-то вносит только в первую таблицу, которая расположена на листе (данные записываются в листы: 2015, 2016, 2017, 2018).


Код
Private Sub CommandButton1_Click()
If Me.ComboBox1.Text = "" Then
    MsgBox "Заполните поле <Год выпуска>", vbExclamation, "Ошибка"
    Me.ComboBox1.SetFocus
    Exit Sub
End If
If Me.ComboBox2.Text = "" Then
    MsgBox "Заполните поле <Месяц выпуска>", vbExclamation, "Ошибка"
    Me.ComboBox2.SetFocus
    Exit Sub
End If
If Me.ComboBox3.Text = "" Then
    MsgBox "Заполните поле <Причина поломки>", vbExclamation, "Ошибка"
    Me.ComboBox3.SetFocus
    Exit Sub
End If
If Me.TextBox1 = "" Then
    MsgBox "Заполните поле <Количество>", vbExclamation, "Ошибка"
    Me.TextBox1.SetFocus
    Exit Sub
End If
Dim FR As Range, cl%, rw%
With Sheets(ComboBox1.Text)
Set FR = .Range("A1:CC1000").Find(ComboBox1.Text)
If FR Is Nothing Then MsgBox "Заполните все поля": Exit Sub
Set FR = .Range("A1:CC1000").Find(ComboBox2.Text)
If FR Is Nothing Then MsgBox "Месяц не найден": Exit Sub
cl = FR.Column
Set FR = .Range("A1:CC1000").Find(ComboBox3.Text)
If FR Is Nothing Then MsgBox "Причина поломки не найдена": Exit Sub
rw = FR.Row
.Cells(rw, cl) = .Cells(rw, cl) + TextBox1.Value
End With
   Unload UserForm1
   ActiveWorkbook.Save
   MsgBox "Информация добавлена!", vbInformation, "Отлично!"
End Sub
Изменено: Павел Ершов - 10.09.2018 09:03:00 (Добавил текст)
С уважением, Ершов Павел


 
А сейчас в чем проблема?
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, Не получается заставить код вписать значения в нужную таблицу. Таблиц на одном листе 4 шт., они одинаковые, отличаются только названием заголовка.
С уважением, Ершов Павел


 
Цитата
Павел Ершов написал:
Не получается заставить код вписать значения в нужную таблицу
А какая из 4-х таблиц - нужная? С ходу сложно понять, подскажите, пожалуйста.
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Михаил Лебедев, На форме есть выбор модели насоса, каждая модель (а их 4) имеет свою таблицу на каждом листе. Листы - годы производства насосов.
С уважением, Ершов Павел


 
Понятно. Тогда Вам надо менять диапазон поиска в зависимости от выбранной модели.
Например - так (изменения - с 22 строки кода).
Код
Private Sub CommandButton1_Click()
If Me.ComboBox1.Text = "" Then
    MsgBox "Заполните поле <Год выпуска>", vbExclamation, "Ошибка"
    Me.ComboBox1.SetFocus
    Exit Sub
End If
If Me.ComboBox2.Text = "" Then
    MsgBox "Заполните поле <Месяц выпуска>", vbExclamation, "Ошибка"
    Me.ComboBox2.SetFocus
    Exit Sub
End If
If Me.ComboBox3.Text = "" Then
    MsgBox "Заполните поле <Причина поломки>", vbExclamation, "Ошибка"
    Me.ComboBox3.SetFocus
    Exit Sub
End If
If Me.TextBox1 = "" Then
    MsgBox "Заполните поле <Количество>", vbExclamation, "Ошибка"
    Me.TextBox1.SetFocus
    Exit Sub
End If
Dim rng As String
Dim FR As Range, cl%, rw%
With Sheets(ComboBox1.Text)
Select Case VBA.Left(Me.ComboBox4.Text, 1)
Case "1"
    rng = "A1:CC23"
Case "2"
    rng = "A24:CC45"
Case "3"
    rng = "A46:CC67"
Case "4"
    rng = "A68:CC88"
End Select
Set FR = .Range(rng).Find(ComboBox1.Text)
If FR Is Nothing Then MsgBox "Заполните все поля": Exit Sub
Set FR = .Range(rng).Find(ComboBox2.Text)
If FR Is Nothing Then MsgBox "Месяц не найден": Exit Sub
cl = FR.Column
Set FR = .Range(rng).Find(ComboBox3.Text)
If FR Is Nothing Then MsgBox "Причина поломки не найдена": Exit Sub
rw = FR.Row
.Cells(rw, cl) = .Cells(rw, cl) + TextBox1.Value
End With
   Unload UserForm1
   ActiveWorkbook.Save
   MsgBox "Информация добавлена!", vbInformation, "Отлично!"
End Sub
Изменено: Михаил Лебедев - 10.09.2018 11:59:59 (внес пояснение)
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Михаил Лебедев, Спасибо, все прекрасно работает и именно как нужно!)
С уважением, Ершов Павел


Страницы: 1
Наверх