Rafael Descio

Srs, Eu estou tentando filtrar uma lista que posso fazer com vários palavras, no momento só consigo com apenas uma uma palavras, porque eu possuo uma lista com diversos departamentos, preciso puxar diversos departamentos com várias informações. Será alguém pode me ajudar ??? Agradeço desde já, segue abaixo o comando como funciona com uma opção única. Peço que detalhe bem... estou bastante enferrujado neste assunto de programação.. anos sem programar... Private Sub CommandButton7_Click() Pesquisa ("Backlog_Geral") End Sub Private Sub Pesquisa(ByVal strTipoPesq As String) Dim strPesquisa As String Dim intContador As Integer Dim intContResul As String Dim intNumColuna As Integer Dim strPlanilha As String 'Verifica o tipo da pesquisa If strTipoPesq = "Backlog_Geral" Then 'atribui o nome da planilha que será usada na pesquisa strPlanilha = strTipoPesq 'Solicita a entrada de um nome de aplicativo strPesquisa = Trim(VBA.Interaction.InputBox("Digite as aréas para Filtrar :", "")) 'Atribui o número da coluna correspondente intNumColuna = 4 End If 'Caso nada tenha sido digitado ou cancelado, sai da rotina If strPesquisa = "" Then Exit Sub End If 'Inicia o contador de linhas e de pesquisa intContador = 2 intContResul = 6 'Limpa eventuais resultados antigos 'Worksheets("Pesquisa").Range("A6", "F" & Worksheets("Pesquisa").Rows.Count).Delete 'Varre linha por linha Do 'Verifica se tem linhas a serem lidas ainda If Worksheets(strPlanilha).Cells(intContador, 1) <> "" Then 'Verifica se o nome digitado foi localizado If InStr(UCase(Worksheets(strPlanilha).Cells(intContador, intNumColuna)), UCase(strPesquisa)) <> 0 Then 'Ativa a sheet de pesquisas Worksheets("TESTE").Activate 'Copia os dados para a sheet de pesquisas Worksheets(strPlanilha).Cells(intContador, 1).Copy Worksheets("TESTE").Cells(intContResul, 1).Activate Worksheets("TESTE").Paste Worksheets(strPlanilha).Cells(intContador, 2).Copy Worksheets("TESTE").Cells(intContResul, 2).Activate Worksheets("TESTE").Paste Worksheets(strPlanilha).Cells(intContador, 3).Copy Worksheets("TESTE").Cells(intContResul, 3).Activate Worksheets("TESTE").Paste Worksheets(strPlanilha).Cells(intContador, 4).Copy Worksheets("TESTE").Cells(intContResul, 4).Activate Worksheets("TESTE").Paste Worksheets(strPlanilha).Cells(intContador, 5).Copy Worksheets("TESTE").Cells(intContResul, 5).Activate Worksheets("TESTE").Paste 'monta a string de busca If strPlanilha = "Backlog_Geral" Then Worksheets("TESTE").Cells(intContResul, 5) = "('Name' = """ & Worksheets("Backlog_Geral").Cells(intContador, 1) & """ AND 'Category' = ""Serviço"" AND 'Type' = ""Serviços de TI"" AND 'Item' =""NA"" AND 'Item' =""NA"" ) OR ('Name' = """ & Worksheets("Backlog_Geral").Cells(intContador, 3) & """ AND 'Category' = ""Negócio"" AND 'Type' = ""NA"" AND 'Item' =""NA"")" Else Worksheets("TESTE").Cells(intContResul, 5) = "('Name' = """ & Worksheets("Backlog_Geral").Cells(intContador, 1) & """ AND 'Type' = ""Palavra"") OR ('Name' = """ & Worksheets("Backlog_Geral").Cells(intContador, 3) & """ AND 'Category' = ""Negócio"" AND 'Type' = ""NA"")" End If 'Incrementa o contador de pesquisa intContResul = intContResul + 1 End If 'Caso não tenha localizado Else 'Sai da rotina Exit Do End If 'Incrementa o contador de linhas intContador = intContador + 1 Loop 'Se nenhuma ocorrência foi encontrada, permite ao usuário tentar novamente If intContResul < 5 Then If MsgBox("Nenhuma palavra semelhante foi localizada. Deseja tentar novamente?", vbYesNo) = vbYes Then 'Chama novamente a rotina Pesquisa strTipoPesq End If ElseIf intContResul = 5 Then 'Copia a fórmula para a área de transferência e avisa o usuário Worksheets("TESTE").Cells(3, 6).Copy MsgBox "A string de pesquisa foi copiada para a área de transferência." Else 'Avisa que mais de um registro foi localizado MsgBox "A pesquisa retornou mais de uma ocorrência." End If 'Fim End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub

Srs, Para melhor explicação, não esta sendo filtrado, ou seja, ele não esta buscando na outra planilha as relações que preciso buscar, preciso pegar tudo que foi feito de hoje até 90 dias atrás - exemplo: >=24/02/2010 00:00:00. Não esta trazendo exatamente o que eu quero, só esta aceitando apenas os números, como 30, 2010, não aceita os sinais de maior (>), igual (=) e etc.... ou seja não esta funcionando. Fico no aguardo. Obrigado. Rafael.

Pessoas, Eu estou tentando importar de uma outra planilha (aba) uma lista que contém mais de 3.000 registros (possui 4 coluna, a segunda com a data e horas - 4/3/2010 10:20:06) com data / hora de 90 dias atrás até hoje para uma nova planilha, mas não estou conseguindo, por alguma razão está faltando... algum código... Alguém pode me ajudar? ... Agradeço desde já. Rafael. Private Sub CommandButton2_Click() Relatório_Geral ("Relatório_Geral") End Sub Private Sub Relatório_Geral(ByVal strTipoPesq) Dim strPesquisa Dim intContador Dim intContResul Dim intNumColuna Dim strPlanilha Inf strTipoPesq = "Relatório_Geral" then strPlanilha = straTipoPesq strPesquisa = Tri(VBA.Interaction.InputBox("Digite a data a pesquisar:", "Pesquisa")) intNumConta = 2 End If If strPesquisa = "" Then Exit Sub End If intContador = 2 intContResult = 7 'Precisa começar na linha devido a minha planilha esta formatado no padrão da empresa 'Worksheets("Relatório_90dias).Range("A", "D" & Worksheets("Relatório_90dias").Rows.Count).Delete 'Apagar as informações que já contem para deixar livre Do If Worksheets(strPlanilha).Cells(intContador,1) <> "" then If InStr(UCase(Worksheets(strPlanilha).Cells(intContador, intNumColuna)),UCase(strPesquisa)) <> 0 then Worksheets("Relatório_90dias").Activate Worksheets(strPlanilha).Cells(intContador, 1).Copy Worksheets("Relatório_90dias").Cells(intContResul, 1).Activate Worksheets("Relatório_90dias").Paste Worksheets(strPlanilha).Cells(intContador, 2).Copy Worksheets("Relatório_90dias").Cells(intContResul, 2).Activate Worksheets("Relatório_90dias").Paste Worksheets(strPlanilha).Cells(intContador, 3).Copy Worksheets("Relatório_90dias").Cells(intContResul, 3).Activate Worksheets("Relatório_90dias").Paste Worksheets(strPlanilha).Cells(intContador, 4).Copy Worksheets("Relatório_90dias").Cells(intContResul, 4).Activate Worksheets("Relatório_90dias").Paste Worksheets(strPlanilha).Cells(intContador, 5).Copy Worksheets("Relatório_90dias").Cells(intContResul, 5).Activate Worksheets("Relatório_90dias").Paste If strPlanilha = "Relatório_Geral" Then Worksheets("Relatório_90dias").Cells(intContResul,8) = "('Name' = "" & Worksheets("Relatório_90dias").Cells(intContador, 1) & "" AND 'Category' = ""Serviço"" AND 'Type' = ""Serviços de TI"" AND 'item' = ""NA"" AND 'item' = ""NA"") OR ('Name' = "" & Worksheets ("Relatório_90dias"). Cells(intContador,3) & "" AND 'Category' ""Negócio"" AND 'Type' = ""NA"" AND 'Item' = ""NA"")" Else Worksheets("Relatório_90dias").Cells(intContResul,8) = "('Name' = "" & Worksheets("Relatório_90dias").Cells(intContador,1) & "" AND 'Type' = ""Palavra"") OR ('Name' = "" & Worksheets ("Relatório_90dias"). Cells(intContador, 3) & "" AND 'Category' ""Negócio"" AND 'Type' = ""NA"")" End If intContResul = intContResul + 1 End If Else Exit Do End If intContador = intContador + 1 Loop If intContResul < 5 then If MsgBox("Nenhuma dta semelhante foi localizado. Deseja tentar novamente ?", vbYesNo) = vbYes then Relatório_Geral strTipoPesq End If Elsef intContResul = 5 then Worksheets("Relatório_90dias").Cells(7,2)Copy MsgBox "Foram copiados para a área de transferência." Else MsgBox "A pesquisa retornou mais que uma ocorrência." End IF End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub