Boa tarde.
Desenvolvi um programa pra cadastrar defeitos de uma linha de produção e preciso usar o NUMERO DE SÉRIE como parâmetro de cadastro. Ou seja, se já tiver cadastrado, ao clicar no botão, ele apenas altera os novos dados, senão ele adiciona um novo cadastro em outra linha.
No entanto ele demora para fazer os cálculos e gostaria de deixar um pouco mais eficiente. Como foi pegando retalhos daqui e dali, acredito que dê pra juntar algumas coisas e deixa-lo mais leve.
Desde já agradeço pela ajuda!
Segue a imagem e o código do programa.
CÓDIGO:
Private Sub cmdadc_Click()
Dim rang As Range
Set rang = Range("B:B")
Dim rangCel As Range
Dim regExiste As Boolean
regExiste = False
For Each rangCel In rang.Cells
If rangCel.Value = txtserial.Text Then
regExiste = True
End If
Next
If regExiste = True Then
Range("B3").Select
Do While ActiveCell <> ""
If txtserial.Value = ActiveCell Then
ActiveCell.Offset(0, 1).Value = cbmod
ActiveCell.Offset(0, 2).Value = cbcor
ActiveCell.Offset(0, 3).Value = txtdata
ActiveCell.Offset(0, 4).Value = cbdef1
ActiveCell.Offset(0, 5).Value = cbdef2
ActiveCell.Offset(0, 6).Value = cbdef3
ActiveCell.Offset(0, 7).Value = cbdef4
ActiveCell.Offset(0, 8).Value = cbdef5
ActiveCell.Offset(0, 9).Value = txtobs
End If
ActiveCell.Offset(1, 0).Activate
Loop
MsgBox "ALTERADO COM SUCESSO!", vbInformation
Exit Sub
Else
If txtserial = "" Or cbmod = "" Then
MsgBox "PREENCHER TODOS OS CAMPOS com (*)", vbExclamation, "CAMPO VAZIO"
txtserial.SetFocus
Else:
'Ativar a primeira planilha
ThisWorkbook.Worksheets("DEFEITOS").Activate
Dim ultimalinha As Long
ultimalinha = Cells(Rows.Count, 2).End(xlUp).Row + 1
Worksheets(1).Range("B" & ultimalinha).Value = UserForm1.txtserial
Worksheets(1).Range("C" & ultimalinha).Value = UserForm1.cbmod
Worksheets(1).Range("D" & ultimalinha).Value = UserForm1.cbcor
Worksheets(1).Range("E" & ultimalinha).Value = Now
Worksheets(1).Range("F" & ultimalinha).Value = UserForm1.cbdef1
Worksheets(1).Range("G" & ultimalinha).Value = UserForm1.cbdef2
Worksheets(1).Range("H" & ultimalinha).Value = UserForm1.cbdef3
Worksheets(1).Range("I" & ultimalinha).Value = UserForm1.cbdef4
Worksheets(1).Range("J" & ultimalinha).Value = UserForm1.cbdef5
Worksheets(1).Range("K" & ultimalinha).Value = UserForm1.txtobs
MsgBox "ALTERADO COM SUCESSO!", vbInformation, "Cadastrado"
End If
End If
End Sub
https://uploaddeimagens.com.br/imagens/1-jpg-6a17fbc6-21ec-4887-ba86-a2ec61e2d425
Postado : 12/07/2018 10:45 am