Copiei e adaptei o seguinte código da internet à minha planilha:
O problema é que o textbox 2 trata-se de horas, na planilha onde é lançado, os dados são salvos como hora, porém quando pesquiso ele aparece como número decimal 0,56568454.
Outro problema é que o textbox 3 trata-se de data, na planilha onde é lançado, os dados são salvos no mesmo formato de data que lançei. O problema é que fiz também uma pesquisa com uma fórmula, em outra aba, para pesquisar a partir da data e a pesquisa só reconhece a data quando entro na aba onde os dados estão salvos e clico na data e dou enter, sem acrescentar nada.
Public MatrizResultadosLinha As Variant
Public MatrizResultadosPlanilha As Variant
Public Total_Ocorrencias As Long
Public sCriterioDaBusca As String
Public sAcaoRequerida As String
Private Sub btn_Adicionar_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
End Sub
Private Sub btn_Adicionar_Click()
'Definir a ação do comando
sAcaoRequerida = "Adicionar"
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(True)
End Sub
Private Sub btn_Cancelar_Click()
'Definir a ação do comando
sAcaoRequerida = ""
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(False)
'Recarrega os controles com os valores ativos na memória
Call SpinButton1_Change
txt_Procurar.Text = sCriterioDaBusca
End Sub
Private Sub btn_Editar_Click()
'Definir a ação do comando
sAcaoRequerida = "Editar"
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(True)
End Sub
Private Sub btn_Excluir_Click()
Dim sLinha As Long
Dim iPlanilha As Integer
If MsgBox("Tem certeza que deseja eliminar este cadastro do sistema?", vbDefaultButton2 + vbQuestion + vbYesNo, Me.Caption) = vbYes Then
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
'Exclui a linha do registro
Sheets(iPlanilha).Rows(sLinha).Delete
'Salva o arquivo
ThisWorkbook.Save
'Recarrega os registros para o formulário
txt_Procurar.Text = sCriterioDaBusca
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If
End Sub
Private Sub btn_Procurar_Click()
If txt_Procurar.Text = "" Then
MsgBox "Digite um valor para a pesquisa"
Else
sCriterioDaBusca = txt_Procurar.Text
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If
End Sub
Private Sub btn_Salvar_Click()
Dim sLinha As Long
Dim iPlanilha As Integer
'Realiza a ação apropriada
Select Case sAcaoRequerida
Case "Adicionar"
With Sheets(Combo_OndeSalvar.Text)
sLinha = .Range("A1").SpecialCells(xlLastCell).Row + 1 'Pega a próxima linha vazia para cadastrar novo
'Grava os novos valores informados no formulário para a planilha base de dados
.Cells(sLinha, 1).Value = TextBox1.Text
.Cells(sLinha, 2).Value = TextBox2.Text
.Cells(sLinha, 3).Value = TextBox3.Text
.Cells(sLinha, 4).Value = TextBox4.Text
.Cells(sLinha, 5).Value = TextBox5.Text
.Cells(sLinha, 6).Value = TextBox6.Text
.Cells(sLinha, 7).Value = TextBox7.Text
.Cells(sLinha, 8).Value = TextBox8.Text
.Cells(sLinha, 9).Value = TextBox9.Text
End With
Case "Editar"
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
With Sheets(iPlanilha)
'Atualiza os dados na linha de registro específica
.Cells(sLinha, 1).Value = TextBox1.Text
.Cells(sLinha, 2).Value = TextBox2.Text
.Cells(sLinha, 3).Value = TextBox3.Text
.Cells(sLinha, 4).Value = TextBox4.Text
.Cells(sLinha, 5).Value = TextBox5.Text
.Cells(sLinha, 6).Value = TextBox6.Text
.Cells(sLinha, 7).Value = TextBox7.Text
.Cells(sLinha, 8).Value = TextBox8.Text
.Cells(sLinha, 9).Value = TextBox9.Text
End With
Case Else
Exit Sub
End Select
'Definir a ação do comando
sAcaoRequerida = ""
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(False)
'Recarrega os valores da pesquisa para exibir no formulário
If sCriterioDaBusca <> "" Then
txt_Procurar.Text = sCriterioDaBusca
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If
'Salva o arquivo
ThisWorkbook.Save
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub Label1_Click()
End Sub
Private Sub Label9_Click()
End Sub
Private Sub SpinButton1_Change()
Dim sLinha As Long
Dim iPlanilha As Integer
Dim TotalOcorrencias As Long
If IsArray(MatrizResultadosLinha) Then 'Verifica se há informações de busca na matriz de resultados
'Se houver dados retornados da busca, então carrega no formulário
TotalOcorrencias = SpinButton1.Max + 1
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias
With Sheets(iPlanilha)
Label_PlanBase.Caption = "Em " & .Name
TextBox1.Text = .Cells(sLinha, 1).Value
TextBox2.Text = .Cells(sLinha, 2).Value
TextBox3.Text = .Cells(sLinha, 3).Value
TextBox4.Text = .Cells(sLinha, 4).Value
TextBox5.Text = .Cells(sLinha, 5).Value
TextBox6.Text = .Cells(sLinha, 6).Value
TextBox7.Text = .Cells(sLinha, 7).Value
TextBox8.Text = .Cells(sLinha, 8).Value
TextBox9.Text = .Cells(sLinha, 9).Value
End With
End If
End Sub
Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String, ByVal sPesquisarNoCampo As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim ResultadosLinha As String
Dim ResultadosPlanilha As String
Dim sSearchInCol As String
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer
'Define a Coluna onde a informação será pesquisada
sSearchInCol = ConfigColunas(sPesquisarNoCampo)
'Define as Planilhas onde a informação será pesquisada
arrPesquisarNasPlanilhas = ConfigPlanilhasBase
'Inicializa os resultados
ResultadosLinha = ""
ResultadosPlanilha = ""
MatrizResultadosLinha = ""
MatrizResultadosPlanilha = ""
'Executa a busca
For i = 0 To UBound(arrPesquisarNasPlanilhas)
With Sheets(arrPesquisarNasPlanilhas(i))
If sSearchInCol = "" Then
Set Busca = .Cells.Find(What:=TermoPesquisado, After:=.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Else
Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).Find( _
What:=TermoPesquisado, _
After:=.Range(sSearchInCol & "1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If
'Caso tenha encontrado alguma ocorrência...
If Not Busca Is Nothing Then
Primeira_Ocorrencia = Busca.Address
ResultadosLinha = ResultadosLinha & IIf((Len(ResultadosLinha) > 0), ";", "") & Busca.Row 'Lista o primeiro resultado na variavel - linha da ocorrência
ResultadosPlanilha = ResultadosPlanilha & IIf((Len(ResultadosPlanilha) > 0), ";", "") & .Index 'Lista o primeiro resultado na variavel - planilha da ocorrência
'Neste loop, pesquisa todas as próximas ocorrências para
'o termo pesquisado
Do
If sSearchInCol = "" Then
Set Busca = .Cells.FindNext(After:=Busca)
Else
Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).FindNext(After:=Busca)
End If
'Condicional para não listar o primeiro resultado
'pois já foi listado acima
If Not Busca.Address Like Primeira_Ocorrencia Then
ResultadosLinha = ResultadosLinha & ";" & Busca.Row
ResultadosPlanilha = ResultadosPlanilha & ";" & .Index
End If
Loop Until Busca.Address Like Primeira_Ocorrencia
End If
End With
Next i
If Len(ResultadosLinha) > 0 Then 'Se foram encontrados resultados
MatrizResultadosLinha = Split(ResultadosLinha, ";")
MatrizResultadosPlanilha = Split(ResultadosPlanilha, ";")
'Atualiza dados iniciais no formulário
SpinButton1.Max = UBound(MatrizResultadosLinha) 'Valor maximo do seletor de registros
'habilita o seletor de registro
SpinButton1.Enabled = True
'indicador do seletor de registros
Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultadosLinha) + 1
'Box com o conteudo encontrado
With Sheets(CInt(MatrizResultadosPlanilha(0)))
Label_PlanBase.Caption = "Em " & .Name
TextBox1.Text = .Cells(MatrizResultadosLinha(0), 1).Value
TextBox2.Text = .Cells(MatrizResultadosLinha(0), 2).Value
TextBox3.Text = .Cells(MatrizResultadosLinha(0), 3).Value
TextBox4.Text = .Cells(MatrizResultadosLinha(0), 4).Value
TextBox5.Text = .Cells(MatrizResultadosLinha(0), 5).Value
TextBox6.Text = .Cells(MatrizResultadosLinha(0), 6).Value
TextBox7.Text = .Cells(MatrizResultadosLinha(0), 7).Value
TextBox8.Text = .Cells(MatrizResultadosLinha(0), 8).Value
TextBox9.Text = .Cells(MatrizResultadosLinha(0), 9).Value
End With
btn_Editar.Enabled = True
btn_Excluir.Enabled = True
Else 'Caso nada tenha sido encontrado, exibe mensagem informativa
SpinButton1.Enabled = False 'desabilita o seletor de registros
btn_Editar.Enabled = False
btn_Excluir.Enabled = False
Label_Registros_Contador.Caption = "" 'zera os resultados encontrados
Label_PlanBase.Caption = ""
'limpa os campos do formulário
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
MsgBox "Nenhum resultado para '" & TermoPesquisado & "' foi encontrado."
End If
End Sub
Private Sub TextBox3_Change()
End Sub
Private Sub TextBox7_Change()
End Sub
Private Sub txt_Procurar_Change()
End Sub
Private Sub UserForm_Initialize()
SpinButton1.Enabled = False
btn_Editar.Enabled = False
btn_Excluir.Enabled = False
Combo_OndeSalvar.Visible = False
Label_OndeSalvar.Visible = False
Label_Registros_Contador.Caption = ""
Call ConfigurarListaDeCampos
End Sub
Sub ConfigurarListaDeCampos()
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer
With ComboBox1
.Style = fmStyleDropDownList
.AddItem "Tudo" '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
.AddItem "Nome"
.AddItem "Setor"
.AddItem "Tipo de atendimento"
.AddItem "Atendente"
.ListIndex = 0
End With
With Combo_OndeSalvar
'Recupera as Planilhas que são base de dados
arrPesquisarNasPlanilhas = ConfigPlanilhasBase
.Style = fmStyleDropDownList
For i = 0 To UBound(arrPesquisarNasPlanilhas)
.AddItem arrPesquisarNasPlanilhas(i)
Next i
.ListIndex = 0
End With
End Sub
Function ConfigColunas(ByVal sNomeCampo As String) As String
Select Case sNomeCampo
Case "Nome"
ConfigColunas = "A"
Case "Setor"
ConfigColunas = "F"
Case "Data"
ConfigColunas = "G"
Case "Documento"
ConfigColunas = "H"
Case Else '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
ConfigColunas = ""
End Select
End Function
Function ConfigPlanilhasBase() As Variant
Dim sNomeDasPlanilhas As String
'Digite o nome das Planilhasonde os dados deverão ser procurados,
'separados por ponto-e-vírgula (;)
'
sNomeDasPlanilhas = "Plan1;PlanBase2" '<----- Informe as planilhas aqui
Do While (Right(sNomeDasPlanilhas, 1) = ";")
sNomeDasPlanilhas = Left(sNomeDasPlanilhas, Len(sNomeDasPlanilhas) - 1)
Loop
ConfigPlanilhasBase = Split(sNomeDasPlanilhas, ";")
End Function
Sub HabilitarControlesParaEdicao(ByVal bOpcao As Boolean)
'Habilitar Botões Salvar/Cancelar
btn_Salvar.Visible = bOpcao
btn_Cancelar.Visible = bOpcao
btn_Adicionar.Visible = Not (bOpcao)
btn_Editar.Visible = Not (bOpcao)
btn_Excluir.Visible = Not (bOpcao)
btn_Procurar.Enabled = Not (bOpcao)
txt_Procurar.Enabled = Not (bOpcao)
ComboBox1.Enabled = Not (bOpcao)
txt_Procurar.Value = ""
Label_Registros_Contador.Caption = ""
Label_PlanBase.Caption = ""
If bOpcao = False And IsArray(MatrizResultadosLinha) Then
SpinButton1.Enabled = True
Else
SpinButton1.Enabled = False
End If
'Liberar Campos para Edição.
TextBox1.Locked = Not (bOpcao)
TextBox2.Locked = Not (bOpcao)
TextBox3.Locked = Not (bOpcao)
TextBox4.Locked = Not (bOpcao)
TextBox5.Locked = Not (bOpcao)
TextBox6.Locked = Not (bOpcao)
TextBox7.Locked = Not (bOpcao)
TextBox8.Locked = Not (bOpcao)
TextBox9.Locked = Not (bOpcao)
'Limpar o conteúdo dos campos
If sAcaoRequerida <> "Editar" Then
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
TextBox8.Value = ""
TextBox9.Value = ""
Combo_OndeSalvar.Visible = bOpcao
Label_OndeSalvar.Visible = bOpcao
End If
If bOpcao = True Then
TextBox1.SetFocus
End If
End Sub
Postado : 17/10/2017 11:16 am