Notifications
Clear all

CADASTRO DE S/N REPETIDO

2 Posts
2 Usuários
0 Reactions
899 Visualizações
(@vfjunior)
Posts: 0
New Member
Topic starter
 

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
(@klarc28)
Posts: 0
New Member
 
Private Sub cmdadc_Click()

Dim rang As Range
Dim DLin As Long 
DLin = Range("B1").End(xlDown).Row 

Set rang = Range("B" & DLIN)
Dim rangCel As Range
Dim regExiste As Boolean
regExiste = False
For Each rangCel In rang.Cells
If rangCel.Value = txtserial.Text Then
    regExiste = True
EXIT FOR
End If
Next
If regExiste = True Then

'Range("B3").Select
DIM NLINHA AS LONG
NLINHA = 3
Do While Range("B" NLINHA).VALUE <> ""

If txtserial.Value = Range("B" NLINHA).VALUE 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
NLINHA = NLINHA+1
'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
 
Postado : 12/07/2018 11:18 am