Ir ao conteúdo
  • Comunicados

    • Gabriel Torres

      Seja um moderador do Clube do Hardware!   12-02-2016

      Prezados membros do Clube do Hardware, Está aberto o processo de seleção de novos moderadores para diversos setores ou áreas do Clube do Hardware. Os requisitos são:   Pelo menos 500 posts e um ano de cadastro; Boa frequência de participação; Ser respeitoso, cordial e educado com os demais membros; Ter bom nível de português; Ter razoável conhecimento da área em que pretende atuar; Saber trabalhar em equipe (com os moderadores, coordenadores e administradores).   Os interessados deverão enviar uma mensagem privada para o usuário @Equipe Clube do Hardware com o título "Candidato a moderador". A mensagem deverá conter respostas às perguntas abaixo:   Qual o seu nome completo? Qual sua data de nascimento? Qual sua formação/profissão? Já atuou como moderador em algo outro fórum, se sim, qual? De forma sucinta, explique o porquê de querer ser moderador do fórum e conte-nos um pouco sobre você.   OBS: Não se trata de função remunerada. Todos que fazem parte do staff são voluntários.

Basole

Membros Plenos
  • Total de itens

    1.455
  • Registro em

  • Última visita

  • Qualificações

    0%

Reputação

642

Sobre Basole

  • Data de Nascimento 01-02-1974 (44 anos)

Informações gerais

  • Cidade e Estado
    Sampa
  • Sexo
    Masculino
  1. 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.
  2. @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.
  3. 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
  4. 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
  5. 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
  6. 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
  7. 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
  8. 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.
  9. 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.
  10. Creio que o que postei atende essa dificuldade. Sem um modelo ou exemplo, fica difícil querer te ajudar.
  11. @kika.gunesim há diferenças sim, entre o ambiente Win e Mac. Qual a versão do office Mac, que você esta utilizando?
  12. Experimente isso: Sub Remove_celulas_EmBranco() With Range("A3:A100") ' Altere seu intervalo .Value = .Value .SpecialCells(xlCellTypeBlanks).Cells.Delete End With End Sub
  13. @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
  14. @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

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×