Usuário com melhor resposta
Reduzir o código sem perder a funcionalidade

Pergunta
-
Pessoal, alguém mais experiente pode me ajudar a reduzir o código sem perder a funcionalidade? Torná-lo mais curto e inteligente?
Private Sub save_click()
Dim ws As Worksheet
Dim LastRow As Long
Set ws = ThisWorkbook.Sheets("Plan1")
With ws
If Not IsDate(reception) Then
MsgBox ("Insira uma data válida!")
Exit Sub
End If
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(LastRow + 1, 1).Value2 = namebox.Value
.Cells(LastRow + 1, 2).Value2 = cepefi.Value
.Cells(LastRow + 1, 3).Value2 = relation.Value
'.Cells(LastRow + 1, 4).Value2 = reception.Value
.Cells(LastRow + 1, 4).Value2 = CLng(CDate(reception.Value))
.Cells(LastRow + 1, 5).Value2 = departament.Value
End With
If namebox.Text = Empty Then
MsgBox "Insira todos os dados necessários para concluir o cadastro."
namebox.SetFocus
End If
If cepefi.Text = Empty Then
MsgBox "Insira todos os dados necessários para concluir o cadastro."
namebox.SetFocus
End If
If relation.Text = Empty Then
MsgBox "Insira todos os dados necessários para concluir o cadastro."
namebox.SetFocus
End If
If reception.Text = Empty Then
MsgBox "Insira todos os dados necessários para concluir o cadastro."
namebox.SetFocus
End If
If departament.Text = Empty Then
MsgBox "Insira todos os dados necessários para concluir o cadastro."
namebox.SetFocus
End If
namebox = ""
cepefi = ""
relation = ""
reception = ""
departament = ""
namebox.SetFocusEnd Sub
Respostas
-
Private Sub save_click() Dim ws As Worksheet Dim LastRow As Long Set ws = ThisWorkbook.Sheets("Plan1") Dim ctrl As Object For Each ctrl In Me.Controls If TypeName(ctrl) = "TextBox" Then If ctrl.Text = "" Then MsgBox "Insira todos os dados necessários para concluir o cadastro." ctrl.SetFocus Exit Sub End If End If Next ctrl If Not IsDate(reception.value) Then MsgBox ("Insira uma data válida!") Exit Sub End If With ws LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row .Cells(LastRow + 1, 1).Value2 = namebox.Value .Cells(LastRow + 1, 2).Value2 = cepefi.Value .Cells(LastRow + 1, 3).Value2 = relation.Value '.Cells(LastRow + 1, 4).Value2 = reception.Value .Cells(LastRow + 1, 4).Value2 = CDate(reception.Value) .Cells(LastRow + 1, 5).Value2 = departament.Value End With namebox = "" cepefi = "" relation = "" reception = "" departament = "" namebox.SetFocus End Sub
A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com
- Editado AndersonFDiniz2 quinta-feira, 4 de janeiro de 2018 22:06
- Sugerido como Resposta AndersonFDiniz2 quinta-feira, 4 de janeiro de 2018 22:07
- Marcado como Resposta julianorsilverio sexta-feira, 5 de janeiro de 2018 10:11
Todas as Respostas
-
Private Sub save_click() Dim ws As Worksheet Dim LastRow As Long Set ws = ThisWorkbook.Sheets("Plan1") Dim ctrl As Object For Each ctrl In Me.Controls If TypeName(ctrl) = "TextBox" Then If ctrl.Text = "" Then MsgBox "Insira todos os dados necessários para concluir o cadastro." ctrl.SetFocus Exit Sub End If End If Next ctrl If Not IsDate(reception.value) Then MsgBox ("Insira uma data válida!") Exit Sub End If With ws LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row .Cells(LastRow + 1, 1).Value2 = namebox.Value .Cells(LastRow + 1, 2).Value2 = cepefi.Value .Cells(LastRow + 1, 3).Value2 = relation.Value '.Cells(LastRow + 1, 4).Value2 = reception.Value .Cells(LastRow + 1, 4).Value2 = CDate(reception.Value) .Cells(LastRow + 1, 5).Value2 = departament.Value End With namebox = "" cepefi = "" relation = "" reception = "" departament = "" namebox.SetFocus End Sub
A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com
- Editado AndersonFDiniz2 quinta-feira, 4 de janeiro de 2018 22:06
- Sugerido como Resposta AndersonFDiniz2 quinta-feira, 4 de janeiro de 2018 22:07
- Marcado como Resposta julianorsilverio sexta-feira, 5 de janeiro de 2018 10:11
-