Basole

Use o excel

Sim, fazer pesquisa com a inserção de mais de uma variável em toda a aba, já é algo mais simples: 1º Insira + um textbox para inserir os termos de pesquisa. 2º renomeei para txtPesquisa A macro vai entender que os espaços é o que separa, os termos que deverão ser pesquisados 3º substitua o código abaixo do botão pesquisar Private Sub btnPesquisar_Click() Dim r As Range Dim O_Q() As String Dim arrLB As Variant Dim i As Integer Dim ws1 As Worksheet O_Q() = VBA.Split(Me.txtPesquisa.Text) ReDim arrLB(0, 11) Set ws1 = Plan16 With Me.ListBox1 .ColumnCount = 11 .ColumnWidths = "30;40;50;40;80;50;70;70;70;70;70" .List = arrLB .Clear For i = LBound(O_Q) To UBound(O_Q) If VBA.IsDate(O_Q(i)) Then Set r = FindAll(VBA.CDate(O_Q(i))) Else Set r = FindAll(O_Q(i)) End If If Not r Is Nothing Then .AddItem .List(.ListCount - 1, 0) = ws1.Range("A" & r.Row).Value .List(.ListCount - 1, 1) = ws1.Range("B" & r.Row).Value .List(.ListCount - 1, 2) = ws1.Range("C" & r.Row).Value .List(.ListCount - 1, 3) = ws1.Range("D" & r.Row).Value .List(.ListCount - 1, 4) = ws1.Range("E" & r.Row).Value .List(.ListCount - 1, 5) = ws1.Range("F" & r.Row).Value .List(.ListCount - 1, 6) = ws1.Range("G" & r.Row).Value .List(.ListCount - 1, 7) = ws1.Range("H" & r.Row).Value .List(.ListCount - 1, 8) = ws1.Range("I" & r.Row).Value .List(.ListCount - 1, 9) = ws1.Range("J" & r.Row).Value .List(.ListCount - 1, 10) = ws1.Range("K" & r.Row).Value End If Next i End With Call HabilitaControles End Sub 4º E em um modulo, cole a função FindAll: (*esta função é que faz a pesquisa em toda as celulas na aba) Function FindAll(what, Optional SearchWhat As Variant, _ Optional LookIn, _ Optional LookAt, _ Optional SearchOrder, _ Optional SearchDirection As XlSearchDirection = xlNext, _ Optional MatchCase As Boolean = False, _ Optional MatchByte, _ Optional SearchFormat) As Range Dim aRng As Range If IsMissing(SearchWhat) Then On Error Resume Next Set aRng = ActiveSheet.UsedRange On Error GoTo 0 ElseIf TypeOf SearchWhat Is Range Then If SearchWhat.Cells.Count = 1 Then Set aRng = SearchWhat.Parent.UsedRange Else Set aRng = SearchWhat End If ElseIf TypeOf SearchWhat Is Worksheet Then Set aRng = SearchWhat.UsedRange Else Exit Function '***** End If If aRng Is Nothing Then Exit Function '***** Dim FirstCell As Range, CurrCell As Range With aRng.Areas(aRng.Areas.Count) Set FirstCell = .Cells(.Cells.Count) End With Set FirstCell = aRng.Find(what:=what, After:=FirstCell, _ LookIn:=LookIn, LookAt:=LookAt, _ SearchDirection:=SearchDirection, MatchCase:=MatchCase, _ MatchByte:=MatchByte, SearchFormat:=SearchFormat) If FirstCell Is Nothing Then Exit Function '***** Set CurrCell = FirstCell Set FindAll = CurrCell Do Set FindAll = Application.Union(FindAll, CurrCell) Set CurrCell = aRng.Find(what:=what, After:=CurrCell, _ LookIn:=LookIn, LookAt:=LookAt, _ SearchDirection:=SearchDirection, MatchCase:=MatchCase, _ MatchByte:=MatchByte, SearchFormat:=SearchFormat) Loop Until CurrCell.Address = FirstCell.Address End Function Até é possível, mas já é mais complicado para atender esta demanda, pois tem que criar muitas condições e fazer tipo uma pesquisa em um banco de palavras para comparar o que foi digitado e fazer a correção.

@Rafael Damian para que possam entender melhor o que você precisa e analisar o formato do seu Documento, poste seu arquivo ou um modelo bem próximo.

Não sei se entendi bem o que precisa, de qualquer forma veja se é isso: Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' Clear the color of all the cells Cells.Interior.ColorIndex = 0 If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub Application.ScreenUpdating = False With ActiveCell ' Highlight the row and column that contain the active cell, within the current region Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + _ .CurrentRegion.Column - 1)).Interior.ColorIndex = ActiveSheet.Tab.ColorIndex End With Application.ScreenUpdating = True End Sub

Neste modelo você pode pesquisar em qualquer campo, mas tem que digitar o termo no campo correto e com essas alterações abaixo no botão de pesquisa: Substitua o código do botão "Pesquisar Registro" por este: Private Sub btnPesquisar_Click() Dim lngRow As Long Dim X As Long, y As Long: y = 0 Dim o que As String If Me.txtID.Text <> "" Then X = 1: o que = Me.txtID.Text: GoTo Px If Me.txtSolicitante.Text <> "" Then X = 3: o que = Me.txtSolicitante.Text: GoTo Px If Me.txtREQ.Text <> "" Then X = 4: o que = Me.txtREQ.Text: GoTo Px If Me.cboComplexidade.Text <> "" Then X = 5: o que = Me.cboComplexidade.Text: GoTo Px If Me.cboTI.Text <> "" Then X = 7: o que = Me.cboTI.Text: GoTo Px If Me.txtResponsavel.Text <> "" Then X = 9: o que = Me.txtResponsavel.Text: GoTo Px If Me.cboStatus.Text <> "" Then X = 10: o que = Me.cboStatus.Text: GoTo Px Px: With ThisWorkbook.Worksheets("Demandas Internas") lngRow = fMatch(o que, .Columns(X)) If lngRow = 0 Then MsgBox "Dados não encontrados!", vbCritical Else Call Multipla_Pesquisa Call HabilitaControles End If End With End Sub * Substitua no codigo o que for "o que" pela letra O + a letra q pois o corretor alterou tudo Conforme a imagem: No botão "Cancelar", pra mim aqui está ok. Já o "fechar" mantenha somente o unload me , pois não existe neste modelo o userform frmMenu, por isso o erro. Private Sub cmdFechar_Click() Unload Me End Sub

Veja este exemplo: Dim LR As Long Dim LC As Long With ActiveSheet On Error Resume Next If .AutoFilterMode Then .ShowAllData End If On Error GoTo 0 LR = .Cells(.Rows.Count, 1).End(xlUp).Row LC = .Cells(1, .Columns.Count).End(xlToLeft).Column .Range(.Cells(1, 1), .Cells(LR, LC)).AutoFilter Field:=1, Criteria1:=RGB(255, _ 255, 204), Operator:=xlFilterCellColor ActiveWindow.SmallScroll Down:=-12 .Range("A2").Select .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.EntireRow.Delete LR = .Cells(.Rows.Count, 1).End(xlUp).Row .Range(.Cells(1, 1), .Cells(LR, LC)).AutoFilter Field:=1 On Error Resume Next If .AutoFilterMode Then .ShowAllData End If On Error GoTo 0 End With

Desculpe, mas acho que não entendeu. Tem que substituir toda a linha: Set aCell = .Columns(X).Find(What:=o que, _ LookIn:=xlValues, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) Por Esta: Set aCell = .Columns(X).Find(What:=o que, _ LookIn:=xlValues, LookAt:=xlPart) E tambem o corretor ortográfico aqui do forum, ele altera algumas coisa do código, que postamos aqui Por exemplo:o que o correto é a letra O junto com a letra q. Não dá em pra por junto as letras, que ele altera, após salvar o post

Desculpe @kika.gunesim desconsidere minhas mensagens anteriores .... Eu fiz um teste aqui no Mac e rodou, o unico problema que apresentou ate agora foi no comando de pesquisa. Mas até ja resolvi agora. *O motivo das minhas afirmacoes anterirores, é que teve um outro caso que tive que criar um novo Userform, pois o Mac naó deixava nem abrir no vbe. O erro que apresentou aqui pra mim foi na pesquisa. No Sub Multipla_Pesquisa Altere a linha Set aCell = .Columns(X).Find(oq_ Lookin:= .... por esta: Set aCell = .Columns(X).Find(o que, _ Lookin:=xlvalues, LookAt:=xlPart) Set aCell = .Columns(X).Find(o que, _ Lookin:=xlvalues, LookAt:=xlPart) adicionado 20 minutos depois Insira um novo Módulo, e neste modulo coloque a macro para abrir o Form. Sub Abrir_Form() frmDemandasInternas.Show End Sub Click com o botão direito do mouse sobre o botão e selecione Atribuir Macro, e selecione: Abrir_Form

Sim poderá aproveitar o codigo, talvez tenha alguma diferenças que envolve os codigos de cores do MAC, mas pode ser substituidos. Seria bom se pudesse abrir este formulario no Win, para 'pegar' as informações dos nomes dos controles para depois voce ter esses dados quando for criar no Mac. Não entendi que botão é esse.

Sinto em dizer isso, mas o Formulário (userform), criado no Excel Win, não roda no Excel Mac. Então terá que criar um novo Formulário com todos os controles, textbox, label, botões e etc e para aproveitar o mesmo código, terá que renomear os controles de acordo com o que está no formulário Excel/Win, assim não precisará fazer alterações no codigo.

Creio que o que postei atende essa dificuldade. Sem um modelo ou exemplo, fica difícil querer te ajudar.

@kika.gunesim há diferenças sim, entre o ambiente Win e Mac. Qual a versão do office Mac, que você esta utilizando?

Experimente isso: Sub Remove_celulas_EmBranco() With Range("A3:A100") ' Altere seu intervalo .Value = .Value .SpecialCells(xlCellTypeBlanks).Cells.Delete End With End Sub

@Julianapctt já alterei a macro. "O ministério da saúde adverte, use a mesclagem de células, com moderação". A macro segue a ordem que aparece no visual. No caso do exemplo abaixo Set, Jan, Out, Nov Despesas VBA.xls

@Flávia de Oliveira Batista veja agora, com as alterações a variável Resultados só carrega dados distintos obtidos na pesquisa Private Sub ProcuraPersonalizada(ByVal Pesquisa As String) Dim Busca As Range Dim Primeiro As String Dim Resultados, ABA As String Dim bNaoExist As Boolean Dim dic As Object ABA = ComboBox1.Text Set dic = CreateObject("Scripting.Dictionary") 'Executa a busca With Worksheets(ABA).Range("A:G") Set Busca = .Find(What:=Pesquisa, AFTER:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 'Caso tenha encontrado alguma ocorrência... If Not Busca Is Nothing Then Primeiro = Busca.Address 'Neste loop, pesquisa todas as próximas ocorrências para o termo pesquisado Do 'Condicional para não listar o primeiro resultado pois já foi listado acima If Not Busca.Address Like Primeira_Ocorrencia Then ' Verifica se já existe na coleção essa ocorncia^: If Not dic.Exists(Busca.Row) Then ' .. e se não existir adiciona: dic.Add Busca.Row, Value bNaoExist = True End If If bNaoExist Then If Resultados = "" Then Resultados = Busca.Row Else Resultados = Resultados & ";" & Busca.Row End If bNaoExist = False End If End If Set Busca = Cells.FindNext(AFTER:=Busca) Loop Until Busca.Address Like Primeiro MatrizResultados = Split(Resultados, ";") Set dic = Nothing Resultados = "" 'Atualiza dados iniciais no formulário SpinButton1.Max = UBound(MatrizResultados) '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(MatrizResultados) + 1 'Resultados encontrados NOME = Cells(MatrizResultados(0), 4).Value strFile = Right(NOME, Len(NOME) - InStrRev(NOME, "\")) TextBox1.Text = strFile 'nome TextBox3.Text = Cells(MatrizResultados(0), 2).Value 'autor TextBox4.Text = Cells(MatrizResultados(0), 3).Value 'data TextBox5.Text = Cells(MatrizResultados(0), 4).Value 'endereço TextBox6.Text = Cells(MatrizResultados(0), 1).Value 'extensão Else 'Caso nada tenha sido encontrado, exibe mensagem informativa SpinButton1.Enabled = False 'desabilita o seletor de registros Label_Registros_Contador.Caption = "" 'zera os resultados encontrados 'limpa os campos do formulário TextBox1.Text = "" TextBox5.Text = "" TextBox3.Text = "" TextBox4.Text = "" MsgBox "Nenhum resultado para '" & Pesquisa & "' foi encontrado." End If End With End Sub