Pesquise o conteúdo da célula em uma pasta de trabalho inteira e retorne uma célula específica dessa folha

0

Estou tentando criar uma fórmula para obter uma cadeia de texto especificada em A3 (o texto é T1234-1234 ) e pesquisar essa sequência em outra pasta de trabalho em uma linha especificada, mas em todas as folhas até que uma correspondência seja encontrado e para retornar outra célula dentro da planilha que está sendo pesquisada.

Abaixo está o que tenho trabalhado até agora. Essa fórmula só pode pesquisar uma planilha especificada ( 4372666_A.TXT ) na célula A6 e retornar o valor localizado na célula A7 apenas se A3 estiver localizado na célula A6 na folha 4372666_A.TXT . / p>

Haverá aproximadamente 100 folhas que precisam ser pesquisadas por vez.

=IF(ISNUMBER(SEARCH(A3,'[EDICONFTESTEXCEL.xlsm]4372666_A.TXT'!$A$6)),LEFT(RIGHT('[EDICONFTESTEXCEL.xlsm]4372666_A.TXT'!$A$7,9),7),A3)
    
por JC6568 15.06.2018 / 16:40

2 respostas

0

Eu gostaria de sugerir que o código do VBA pesquisará a sequência de texto em todas as pastas de trabalho de qualquer pasta selecionada e retornará informações completas como Nome da pasta de trabalho, Nome da planilha, Endereço da célula & a string de texto.

Digite o código abaixo escrito como módulo em qualquer planilha existente.

    Sub SearchWorkbooks()

    Dim xFso As Object
    Dim xFld As Object
    Dim xStrSearch As String
    Dim xStrPath As String
    Dim xStrFile As String
    Dim xOut As Worksheet
    Dim xWb As Workbook
    Dim xWk As Worksheet
    Dim xRow As Long
    Dim xFound As Range
    Dim xStrAddress As String
    Dim xFileDialog As FileDialog
    Dim xUpdate As Boolean
    Dim xCount As Long

    On Error GoTo ErrHandler

    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select the forlder"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If

    If xStrPath = "" Then Exit Sub
    xStrSearch = "Ravi"
    xUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Set xOut = Worksheets.Add
    xRow = 1
    With xOut
        .Cells(xRow, 1) = "Workbook"
        .Cells(xRow, 2) = "Worksheet"
        .Cells(xRow, 3) = "Cell"
        .Cells(xRow, 4) = "Text in Cell"

        Set xFso = CreateObject("Scripting.FileSystemObject")
        Set xFld = xFso.GetFolder(xStrPath)
        xStrFile = Dir(xStrPath & "\*.xlsm*")

        Do While xStrFile <> ""
            Set xWb = Workbooks.Open(Filename:=xStrPath & "\" & xStrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
            For Each xWk In xWb.Worksheets
                Set xFound = xWk.UsedRange.Find(xStrSearch)
                If Not xFound Is Nothing Then
                    xStrAddress = xFound.Address
                End If
                Do
                    If xFound Is Nothing Then
                        Exit Do
                    Else
                        xCount = xCount + 1
                        xRow = xRow + 1
                        .Cells(xRow, 1) = xWb.Name
                        .Cells(xRow, 2) = xWk.Name
                        .Cells(xRow, 3) = xFound.Address
                        .Cells(xRow, 4) = xFound.value
                    End If
                    Set xFound = xWk.Cells.FindNext(After:=xFound)
                Loop While xStrAddress <> xFound.Address
            Next
            xWb.Close (False)
            xStrFile = Dir
        Loop
        .Columns("A:D").EntireColumn.AutoFit
    End With
    MsgBox xCount & "cells have been found", , "Search String Across WBKs"
ExitHandler:
    Set xOut = Nothing
    Set xWk = Nothing
    Set xWb = Nothing
    Set xFld = Nothing
    Set xFso = Nothing
    Application.ScreenUpdating = xUpdate
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Como funciona:

  • Executar esta macro.
  • Ele abrirá a caixa de diálogo Gerenciador de arquivos.
  • Selecione a pasta na qual todas as pastas de trabalho estão armazenadas.
  • Conclua com Ok.

O Excel exibirá a caixa de mensagens informando quantas seqüências de texto foram encontradas. Finalmente, uma nova planilha será criada para exibir os resultados, como mostrado abaixo.

N.B.

  • xStrSearch="Ravi" e também .Columns ("A: D"). EntireColumn.AutoFit, são editáveis.

  • Você pode substituir "Ravi" por outra string e a coluna A: D por outra.

por 18.06.2018 / 13:20
0

Aqui está uma UDF agradável e simples que funciona de maneira semelhante à função SEARCH() integrada, exceto que pesquisa todas as planilhas e retorna o valor de uma célula diferente em vez do índice:

'============================================================================================
' Module     : <any standard module>
' Version    : 0.1.0
' Part       : 1 of 1
' References : N/A
' Source     : https://superuser.com/a/1332265/763880
'============================================================================================
Option Explicit

Public Function SEARCHALLSHEETS _
                ( _
                           ByVal find_text As String, _
                           ByVal within_cell As Range, _
                           ByVal return_cell As Range _
                ) _
       As Variant

  Dim strWithinCell As String: strWithinCell = within_cell.Address
  Dim strReturnCell As String: strReturnCell = return_cell.Address

  Dim wkstWorksheet As Worksheet
  For Each wkstWorksheet In within_cell.Parent.Parent.Worksheets
    If InStr(wkstWorksheet.Range(strWithinCell), find_text) > 0 Then
      Dim varReturnValue As Variant
      varReturnValue = wkstWorksheet.Range(strReturnCell).Value2
      Exit For
    End If
  Next wkstWorksheet
  SEARCHALLSHEETS = IIf(IsEmpty(varReturnValue), CVErr(xlErrValue), varReturnValue)

End Function


Uso: SEARCHALLSHEETS(find_text, within_cell, return_cell)

Depois de instalado, você o utiliza fornecendo a célula de destino de pesquisa e a célula de retorno em qualquer planilha de uma pasta de trabalho e ele pesquisará todas as planilhas dessa pasta de trabalho.

Se não for possível encontrar o texto da pesquisa em qualquer uma das planilhas, ele retornará o erro #VALUE! da mesma forma que a função SEARCH() .


Sua fórmula precisa ser reescrita para detectar o erro em vez de um número para determinar se uma correspondência foi encontrada ou não. Além disso, ele também precisa ser modificado para usar o novo valor de retorno.

Esta é sua fórmula atualizada:

=IFERROR(LEFT(RIGHT(SEARCHALLSHEETS(A3,[EDICONFTESTEXCEL.xlsm]Sheet1!$A$6,[EDICONFTESTEXCEL.xlsm]Sheet1!$A$7),9),7),A3)

Existe uma conversão alternativa e mais direta da sua fórmula, mas é muito mais longa. Eu incluí-lo aqui para sua referência:

=IF(NOT(ISERROR(SEARCHALLSHEETS(A3,'[EDICONFTESTEXCEL.xlsm]4372666_A.TXT'!$A$6,'[EDICONFTESTEXCEL.xlsm]4372666_A.TXT'!$A$7))),LEFT(RIGHT(SEARCHALLSHEETS(A3,'[EDICONFTESTEXCEL.xlsm]4372666_A.TXT'!$A$6,'[EDICONFTESTEXCEL.xlsm]4372666_A.TXT'!$A$7),9),7),A3)
    
por 18.06.2018 / 16:10