Anidar un find dentro de otro para cruzar 3 hojas

Tengo una hoja que contiene los proyectos y los valores de cada uno de esos proyectos, la segunda hoja contiene los pedidos que hay para cada uno de esos proyectos y una tercera que contiene las personas asignadas a cada uno de esos pedidos. Con el primer find me encuentra, sin problema, los pedidos para cada uno de los proyectos, pero al añadir el find de la tercera hoja, sólo me encuentra el primer pedido de cada proyecto.

Adjunto código:

Set busco = Sheets("Proyectos_Pedidos").Range("B1:B" & TotalRegPorProyPedido).Find(what:=nombreProyecto, LookIn:=xlValues, SearchOrder:=xlColumns, SearchDirection:=xlNext)
If Not busco Is Nothing Then
       firstAddress = busco.Address

       do

            For u = 1To UltColumnaProyPedidos

                columnaProy = Columna_a_Letras(u) & CStr((busco.Row)) 'Columna_a_letras convierte el número en letra
                columnaDestinoPedido = Columna_a_Letras(u - 1) & CStr((FilaPed))

                Sheets("Proyectos_Pedidos").Range(columnaProy).Copy
                Sheets("Destino").Range(columnaDestinoPedido).PasteSpecial xlPasteAll

                If u = UltColumnaProyPedidos Then 'Si ya he rellenado todas las columnas

'Realizo la búsqueda para que me saque todas las personas asignadas a ese pedido

                    Set buscoEDT = Sheets("EDTs").Range("C1:C" & totalRegEDTs).Find(what:=contraseña, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlColumns, SearchDirection:=xlNext)

                   If Not buscoEDT Is Nothing Then

                       'Si quito éste find y el if funciona perfecto

                   end if

            end if

      next u

      Set busco = Sheets("Proyectos_Pedidos").Range("B1:B" & TotalRegPorProyPedido).FindNext(busco)

Loop While Not busco Is Nothing And busco.Address <> firstAddress

1

1 Respuesta

3.700.800 pts. Si me amas, siempre voy a estar en tu corazón; si me...

H o l a : Me puedes enviar tu archivo con las 3 hojas y un par de ejemplos, me explicas qué datos son los que se tienen que buscar, en dónde se deben buscar, y desde luego, qué datos quieres tomar como resultado de la búsqueda y en dónde los quieres poner. Explica los ejemplos con comentarios y con colores.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Mayte López Moreno” y el título de esta pregunta.

Buenos días Dante Amor, 

Te he enviado el correo, espero que esté todo explicado.

Saludos,

Mayte

H o l a : No es posible anidar el segundo Find, ya que la instrucción FindNext solamente busca el último valor; y lo que tu necesitas es terminar el segundo ciclo y después regresar al primer ciclo y realizar el siguiente FindNext, pero FindNext, por decirlo de alguna forma se quedó con la información del segundo ciclo, entonces, cuando regresas al primer ciclo te envía error.

Te anexo una macro para realizar la segunda búsqueda con el ciclo For

Sub Proyectos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Origen")
    Set h2 = Sheets("Proyectos_Pedidos")
    Set h3 = Sheets("EDTs")
    Set h4 = Sheets("Destino")
    '
    'Limpia hoja destino
    uf = h4.Range("B" & Rows.Count).End(xlUp).Row + 6
    uc = h4.Cells(1, Columns.Count).End(xlToLeft).Column
    h4.Range(h4.Cells(6, 1), h4.Cells(uf, uc)).ClearContents
    '
    fila = 6
    uc3 = h3.Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        '
        '*** Primera búsqueda
        Set r = h2.Columns("B")
        Set b = r.Find(h1.Cells(i, "B"), lookat:=xlWhole)
        If Not b Is Nothing Then
            h1.Range("A" & i & ":" & "K" & i).Copy
            h4.Range("A" & fila).PasteSpecial xlValues
            fila = fila + 1
            celda = b.Address
            Do
                '
                '*** Segunda búsqueda
                pedido = h2.Cells(b.Row, "C")
                seña = h2.Cells(b.Row, "G") 'contraseña
                For j = 2 To h3.Range("C" & Rows.Count).End(xlUp).Row
                    If h3.Cells(j, "C") = seña Then
                        tasa = ""
                        For k = Columns("D").Column To Columns("L").Column
                            If h3.Cells(j, k) <> "" Then tasa = h3.Cells(1, k): Exit For
                        Next
                        h4.Cells(fila, "B") = pedido                'pedido
                        h4.Cells(fila, "C") = tasa                  'tasa
                        h4.Cells(fila, "D") = h3.Cells(j, "M")      'codigo
                        h4.Cells(fila, "E") = h3.Cells(j, "N")      'ingeniero/empleado
                        h4.Cells(fila, "F") = seña                  'contraseña
                        h3.Range(h3.Cells(j, Columns("R").Column), h3.Cells(j, uc3)).Copy
                        h4.Range("O" & fila).PasteSpecial xlValues
                        fila = fila + 1
                    End If
                Next
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        End If
    Next
    MsgBox "Proceso terminado", vbInformation
End Sub

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas