none
Localizar dados em várias planilhas no Excel RRS feed

  • Pergunta

  • Olá a todos do forum, possuo o<taghw> código!!!!!</taghw>

    Sub Procura()
        'Declara uma strign que vai receber o valor a ser procurado na planilha
        Dim procurado As String
        'Declara uma variável para receber o resultado de um MsgBox
        Dim result As VbMsgBoxResult
        'Declara duas variáveis do tipo inteiro
        'i -> Para controlar o laço de repetição
        'QuantPlanilhas -> para armazenar a quantidade de planilhas da pasta de trabalho atual
        Dim i, QuantPlanilhas As Integer
        'Atribui a quantidade de planilhas da pasta atual à variável QuantPlanilhas
        'O método ThisWorkbook.Worksheets.Count retorna esse parâmetro
        QuantPlanilhas = ThisWorkbook.Worksheets.Count
        'Mostra um InputBox para que seja inserido o dado que será procurado em todas a
        'Pasta de trabalho e atribui seu valor à variávle procurado
        procurado = InputBox("Digite o valor a ser procurado", "Valor procurado", "Exemplo, 2, 3, uma data qualquer")
        'Inicia o laço de repetição que varre todas as planilhas da pasta de trabalho atual
        For i = 1 To QuantPlanilhas Step 1
            'Seleciona toda a área da planilha
            With Worksheets(i).Range("A:IV")
                'Efetua o método de busca, que retorna o valor se for encontrado ou
                'Nothing caso não encontre nada
                Set c = .Find(procurado, LookIn:=xlValues)
                'Caso tenha achado algo, ativa a célula onde está o valor procurado
                'e oferece para o usuário se quer ou não continuar a busca
                If Not c Is Nothing Then
                    Worksheets(i).Select
                    Range(c.Address).Select
                    result = MsgBox("Deseja continuar a busca?", vbYesNo, "Continuar?")
                    'Caso queira, continua a busca, caso contrário, sai do laço
                    If result = vbNo Then
                        Exit Sub
                    End If
                End If
            End With
        Next
    End Sub

    Porém gostaria de uma ajuda!!!!!

    Quando eu peço uma nova pesquisa ele não abre a msgbox e gostaria que tivesse um comando que após o resultado localido depois da opção deseja continuar ele retornasse para Plan1.


    Desde já agradeço a atenção.

     
    quarta-feira, 23 de maio de 2012 12:08

Respostas

  • Oi,

    Veja se é isto que você precisa

    Sub aTest()
        Dim procurado As Variant, continua As Variant
        Dim rngFound As Range, wk As Worksheet
        
        procurado = Application.InputBox(Prompt:="Digite o valor a ser procurado", _
            Title:="Procura", Type:=2)
        If procurado = False Or procurado = "" Then Exit Sub
        
        For Each wk In ThisWorkbook.Sheets
            wk.Activate
            Set rngFound = wk.Cells.Find(What:=procurado, LookIn:=xlValues, Lookat:=xlWhole)
            If Not rngFound Is Nothing Then
                rngFound.Select
                continua = MsgBox("Encontrado na planilha " & wk.Name & _
                    " continua a pesquisa?", vbYesNo)
                If continua = vbNo Then Sheets("Plan1").Activate: Exit Sub
            Else
                continua = MsgBox("Não encontrado na planilha " & wk.Name & _
                    " continua a pesquisa?", vbYesNo)
                If continua = vbNo Then Sheets("Plan1").Activate: Exit Sub
            End If
        Next wk
        Sheets("Plan1").Activate
    End Sub

    Espero que ajude

    M.

    quarta-feira, 23 de maio de 2012 18:21

Todas as Respostas

  • Oi,

    Veja se é isto que você precisa

    Sub aTest()
        Dim procurado As Variant, continua As Variant
        Dim rngFound As Range, wk As Worksheet
        
        procurado = Application.InputBox(Prompt:="Digite o valor a ser procurado", _
            Title:="Procura", Type:=2)
        If procurado = False Or procurado = "" Then Exit Sub
        
        For Each wk In ThisWorkbook.Sheets
            wk.Activate
            Set rngFound = wk.Cells.Find(What:=procurado, LookIn:=xlValues, Lookat:=xlWhole)
            If Not rngFound Is Nothing Then
                rngFound.Select
                continua = MsgBox("Encontrado na planilha " & wk.Name & _
                    " continua a pesquisa?", vbYesNo)
                If continua = vbNo Then Sheets("Plan1").Activate: Exit Sub
            Else
                continua = MsgBox("Não encontrado na planilha " & wk.Name & _
                    " continua a pesquisa?", vbYesNo)
                If continua = vbNo Then Sheets("Plan1").Activate: Exit Sub
            End If
        Next wk
        Sheets("Plan1").Activate
    End Sub

    Espero que ajude

    M.

    quarta-feira, 23 de maio de 2012 18:21
  • Ajudou bastante porem eu quero que ache todos os valores em celulas sejam numericos ou texto.

    Muito Obrigada!

    quarta-feira, 23 de maio de 2012 19:27
  • Oi,

    Nos meus testes o código funcionou tanto para texto (por exemplo: Blahblah) como para números (por exemplo: 3)

    M.

    quinta-feira, 24 de maio de 2012 17:43