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
Sangiorgio,
Boa tarde!
Anexe seu arquivo aqui mesmo no fórum, compactado com .ZIP, para que possamos rodar, entender, depurar e ajudar. Aproveite e explique melhor e com maior riqueza de detalhes pois, pelo menos, para mim, sua necessidade não ficou clara.
Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)
Atenciosamente
Wagner Morel
Analisar esta rotina por inteiro sem ter o modelo como o colega Wagner solicitou é meio inviável, mas pelo que está dizendo, eu entendo como falta de conversão dos tipos corretamente e ou formatação dos valores corretamente, uma vez que os TextBox por padrão são do tipo texto.
Quanto a questão da pesquisa ter de estar na aba, voce tem uma Function ConfigPlanilhasBase onde temos duas no Array, onde separamos atraves do Split, mas não temos instrução Set definindo como Worksheet e nem um Sheet Select ou Activate.
Pesquise por Formatação de TextBox e Definição de Tipos e a instrução Set no forum e encontrara vários tópicos a respeito.
[]s
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel