Procv com VBA, muito Fácil

Pessoal pediram para criar um procedimento que estivesse sendo aplicado a Procv, no VBA a Procv se chama Vlookup()
então vamos ao procedimento:


Sub ProcuraV()
On Error GoTo nossoerro

Dim codigo As Variant
Dim tabela As String
Dim vf As Boolean
Dim entrada As Variant

codigo = InputBox("informe o código do cliente")
tabela = "A:E"
vf = False

nome = Application.WorksheetFunction.VLookup(Val(codigo), Range(tabela), 2, vf)
endereco = Application.WorksheetFunction.VLookup(Val(codigo), Range(tabela), 3, vf)
bairro = Application.WorksheetFunction.VLookup(Val(codigo), Range(tabela), 4, vf)
salario = Application.WorksheetFunction.VLookup(Val(codigo), Range(tabela), 5, vf)

MsgBox "Nome: " & vtab & nome _
       & vbCr & "Endereço: " & vtab & endereco _
       & vbCr & "Bairro  : " & vtab & bairro _
       & vbCr & "Salário : " & vtab & salario

nossoerro:
    If Err.Number = 1004 Then
        MsgBox "Este código não está cadastrado", vbCritical
    End If
End Sub

Adicionando um Registro com Validação e Pergunta se continua ou não

Boa noite pessoal, a pedido dos meus alunos estou criando um procedimento que valida a caixa de entrada do usuário e pergunta se devo ou não continuar o cadastro. O procedimento envolve etiquetas de nomes para poder se deslocar alternadamente entre os códigos, se você não conhece o sistema com etiquetas, dê uma olhada detalhada no procedimento para que possa compreender melhor.

Sub cadastrar()
Dim total As Variant
'variáveis de preenchimento
Dim codigo As Variant
Dim nome As Variant
Dim endereco As Variant
Dim bairro As Variant
Dim salario As Variant
total = (Cells(Rows.Count, 1).End(xlUp).Row)
codigo = total + 1
vnome:
nome = Trim(UCase(InputBox("Informe o nome do Cliente")))
vendereco:
endereco = Trim(UCase(InputBox("Informe o endereco do Cliente")))
vbairro:
bairro = Trim(UCase(InputBox("Informe o Bairro do Cliente")))
vsalario:
salario = Trim(InputBox("Informe o Salário do Cliente"))
' fazendo a verificação
If nome = "" Then
Do While contador <> 3
   contador = contador + 1
   MsgBox "Por favor entre com o nome do cliente", vbCritical, "Nome do Cliente vazio"
   continuar = MsgBox("Continuar tentando? ", vbYesNo, vbQuestion, "Continuar?")
  
   If continuar = vbYes Then
      GoTo vnome
   Else
      GoTo final
   End If
  
Loop
End If
If endereco = "" Then
Do While contador <> 3
   contador = contador + 1
   MsgBox "Por favor entre com o endereço do cliente", vbCritical, "Endereço do Cliente vazio"
  
   continuar = MsgBox("Continuar tentando? ", vbYesNo + vbQuestion, "Continuar?")
  
   If continuar = vbYes Then
      GoTo vendereco
   Else
      GoTo final
   End If
  
Loop
End If
If bairro = "" Then
Do While contador <> 3
   contador = contador + 1
   MsgBox "Por favor entre com o Bairro do cliente", vbCritical, "Bairro do Cliente vazio"
   continuar = MsgBox("Continuar tentando? ", vbYesNo + vbQuestion, "Continuar?")
   
    If continuar = vbYes Then
       GoTo vbairro
    Else
       GoTo final
    End If
  
Loop
End If
If salario = "" Then
Do While contador <> 3
   contador = contador + 1
   MsgBox "Por favor entre com o Salario do cliente", vbCritical, "Salario do Cliente vazio"
   continuar = MsgBox("Continuar tentando? ", vbYesNo + vbQuestion, "Continuar?")
  
   If continuar = vbYes Then
      GoTo vsalario
    Else
      GoTo final
    End If
Loop
End If
' ------------------------------- Fim da Validação ---------------------------------

'-------------------- Arnazenando na última linha do cadastro ----------------------
Cells(total + 1, 1).Value = codigo
Cells(total + 1, 2).Value = nome
Cells(total + 1, 3).Value = endereco
Cells(total + 1, 4).Value = bairro
Cells(total + 1, 5).Value = salario
final:
MsgBox "Cadastro cancelado pelo usuário", vbInformation, "cancelado"
End Sub

 

Como Navegar entre os registros

Boa Noite pessoal, hoje estaremos incluindo os botões avançar e recuar na planilha de cadastro, espero que gostem. Este procedimento pode ser aplicado em formulários, como iremos mostrar mais adiante.
Espero que curtam a macro.

Sub Avancar()

Dim total As Variant
total = (Cells(Rows.Count, 1).End(xlUp).Row) - 1
     If ActiveCell.Row > total Then
         MsgBox "Final da listagem"
    Else
         Cells(ActiveCell.Row, 1).Offset(1, 0).Select
      
    End If
end sub

=======================

Sub Recuar()
Dim total As Variant
total = (Cells(Rows.Count, 1).End(xlUp).Row) - 1
     If ActiveCell.Row = 2 Then
         MsgBox "Início da listagem"
    Else
         Cells(ActiveCell.Row, 1).Offset(-1, 0).Select
    End If
End Sub

Como excluir o Registro Atual em VBA

Boa Noite Galera, estou mais uma vez aqui para dar aquela ajudinha em Excel VBA, hoje estaremos exluindo a linha atual do registro. Então vamos lá.

Sub Excluir()
Dim confirmar As Variant
confirmar = MsgBox("Deseja Excluir o Registro: " & ActiveCell.Value & " Sim ou Não", vbYesNo + vbQuestion, "Excluir?")
    If ActiveCell.Row = 1 Then
        MsgBox "Você não pode excluir a linha do Cabeçalho", vbCritical
    Else
         If confirmar = vbYes Then
             Selection.EntireRow.Delete
         Else
         End If
    End If
End sub

agora é só adicionar no Botão e ir para a galera.

Como contar as linhas cadastradas mesmo apresentando linhas em Branco

Boa Noite Pessoal. Aqui vai mais uma dica importante em Excel VBA. Irei mostrar como criar uma macro para contar as linhas cadastradas, mesmo apresentando linhas em Branco.



Sub contagem()

Dim total as variant

range("a1").select
total = (cells(rows.count,1).end(xlup).row)-1
Msgbox "O total de registros é de: " & total

end sub

É isso ae agora atribua a macro em um botão na sua planilha e verifique quantas linhas foram preenchidas no seu cadastro.
Veja  o resultado

Armazenamento de Dados em Pastas utilizando Excel

Ola Boa Noite!

Aqui vai uma dica para quem está procurando cadastrar dados em uma pasta do Excel e armazenar o cadastro em Outra. o Resultado é fantástico. Espero que tenham gostado da dica.


Sub transfer()
 Application.ScreenUpdating = False
 Application.Workbooks.Open ("Saturno\dados_alunos\1\DADOS.XLSX ")
 Windows("DADOS2.XLSm").Activate
 Range("A2:E2").Select
 Selection.Copy
 Windows("DADOS.XLSX").Activate
 Range("A2").Select
 Selection.EntireRow.Insert
 Range("A2").Select
 Selection.PasteSpecial
 Total = (Cells(Rows.Count, 1).End(xlUp).Row) - 1
 Workbooks("DADOS.XLSX").Save
 Windows("DADOS.XLSX").Close
 Range("a2").Select
 MsgBox "Dados Gravados no Servidor com Sucesso... Agora são: " & Total & " de registros cadastrados.", vbInformation, "Dados Gravados..."
 Windows("DADOS2.XLSM").Activate
 Application.WindowState = xlMaximized
 Application.CutCopyMode = False
end Sub