Hola a todos, necesito si podéis que echéis una mano con este código.

El código funciona bien, pero es lento. Porque recorre cada celda de la fila y ejecuta una acción tantas columnas tenga el rango filtrado. No se si se puede hacer que en cuanto encuentre el valor filtrado y ejecute la acción cambie de fila. Eso aceleraría considerablemente el código.

Lo copio y si podéis ayudarme os lo agradezco.

Sub PegarJornadasPnetInst()
ApplicationOff
'
'declaro variables
Dim uf1, uf2, f1 As Long
Dim IDRH, ORDEN As String
Dim celda As Range, rng As Range

'asigno las hojas
Set ws1 = Sheets("Instaladores"): Set ws2 = Sheets("PartePnetInst")

'ultima fila de hojas
uf1 = ws1.Range("A65536").End(xlUp).Row: uf2 = ws2.Range("A65536").End(xlUp).Row
Set rng = Range("A1:J" & uf2)

'recorro cada fila de la hoja ws1
For f1 = 7 To uf1
IDRH = ws1.Range("A" & f1).value: ORDEN = ws1.Range("B" & f1).value

'filtro la hoja ws2 segun los valores de IDRH y ORDEN
With ws2.Range("A1:J" & uf2)
    .AutoFilter
    .AutoFilter Field:=1, Criteria1:=IDRH
    .AutoFilter Field:=2, Criteria1:=ORDEN
    For Each celda In rng.SpecialCells(xlCellTypeVisible)
        
      If Not celda.value = "" And celda.Row > 1 Then
         fila = celda.Row
      'recorro el rango filtrado en la hoja ws2. Cojo el valor de la columna "F", o columna 6,
      'me quedo solo con el día, que son los dos valores de la izquierda, por ejemplo 01/02/2019, sería el 02
         dia = Val(Left(ws2.Cells(fila, 6), 2))
       If ws1.Cells(5, dia + 9) = "S" Or ws1.Cells(5, dia + 9) = "F" Then GoTo 10
       'busco la zona de trabajo
         zona = ws1.Cells(f1, 8)
        Select Case zona
         Case "BARNA"
          zona = "BS"
         Case "MANRESA"
          zona = "TM"
         Case "Especiales"
          zona = "BS"
        End Select
         'asigno la nomenclatura segun la zona
        ws1.Cells(f1, dia + 9) = zona
10:
      Else
      'No se ha encontrado el IDRH y ORDEN, no hago nada
      End If
    Next
    'deshago autofiltro y busco el siguiente de la hoja ws1
    .AutoFilter
End With
Next f1
'
ApplicationOn
End Sub

Moisés.

 

Hola Moisés

Sugiero "subir" el archivo con  al menos parte de los datos para poder hacer pruebas.

Saludos

Abraham Valencia

Hola Abraham, saludos.

Subo un archivo de prueba aquí

https://drive.google.com/open?id=18CELXF2Mp9grlXXg2B3LxoFS62H21RCj

Muchas gracias.

 

Hola

Al activar la macro no veo diferencia entre los datos existentes y los supuestos cambios ¿quizá ya la usaste y ya están hechos dichos cambios en los datos?

Otra cosa, es una mala práctica, en programación, intentar obtener el día de una fecha con funciones como "Left", basta que alguno de tus colegas use un formato tipo "yyyy/mm/dd" para que ya no sea útil.

Ah, en VBA, esto:

Dim uf1, uf2, f1 As Long

Es igual a esto:

Dim uf1 as Variant, uf2 as Variant, f1 As Long

Volviendo al punto, y dado que no sucede nada, quizá si explicas que intentas sea más fácil entender.

Abraham Valencia

Hola Abraham.

Gracias por el consejo de las variables, he modificado el código para atender este error.

Respecto a lo que me sucede te explico.

Lo que necesito es solo recorrer las celdas filtradas. No se por qué no lo hace ahora. He modificado el código y he puesto esto.

 For Each celda In rng1.SpecialCells(xlCellTypeVisible)
    'For Each celda In Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        
      If Not celda.value = "" And celda.Row > 1 Then

Sin embargo cuando corro la macro veo que sigue leyendo las lineas no filtradas.  Imagina leer más de 2.000 lineas tantas veces. Si es cierto que he reducido el tiempo, porque como solo leo la columna "A" no es lo mismo que leer 10 columna como antes, pero en vez de tardar 30 segundos ahora tardo 10 segundos. Me parece excesivo, si consiguiera solo leer los datos filtrados seguro que estaríamos hablando de apenas 1 segundo o algo más.

Ese es el problema que tengo.

Copio el código entero para que lo puedas probar, si te es posible. Si no lo fuera estoy igualmente agradecido.

Un abrazo.

Sub PegarJornadasPnetInst()
ApplicationOff
'
'declaro variables
Dim uf1 As Long, uf2 As Long, f1 As Long
Dim IDRH As String, ORDEN As String
Dim celda As Range, rng As Range, rng1 As Range

'asigno las hojas
Set Ws1 = Sheets("Instaladores"): Set Ws2 = Sheets("PartePnetInst")

'ultima fila de hojas
uf1 = Ws1.Range("A65536").End(xlUp).Row: uf2 = Ws2.Range("A65536").End(xlUp).Row
Set rng = Range("A1:J" & uf2)

'recorro cada fila de la hoja ws1
For f1 = 7 To uf1
IDRH = Ws1.Range("A" & f1).value: ORDEN = Ws1.Range("B" & f1).value

'filtro la hoja ws2 segun los valores de IDRH y ORDEN
With Ws2.Range("A1:J" & uf2)
    .AutoFilter
    .AutoFilter Field:=1, Criteria1:=IDRH
    .AutoFilter Field:=2, Criteria1:=ORDEN
    Set rng1 = Range("A2:A" & uf2)
    For Each celda In rng1.SpecialCells(xlCellTypeVisible)
    'For Each celda In Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        
      If Not celda.value = "" And celda.Row > 1 Then
         fila = celda.Row
      'recorro el rango filtrado en la hoja ws2. Cojo el valor de la columna "F", o columna 6,
      'me quedo solo con el día, que son los dos valores de la izquierda, por ejemplo 01/02/2019, sería el 02
         dia = Val(Left(Ws2.Cells(fila, 6), 2))
       If Ws1.Cells(5, dia + 9) = "S" Or Ws1.Cells(5, dia + 9) = "F" Then GoTo 10
       'busco la zona de trabajo
         zona = Ws1.Cells(f1, 8)
        Select Case zona
         Case "BARNA"
          zona = "BS"
         Case "MANRESA"
          zona = "TM"
         Case "Especiales"
          zona = "BS"
        End Select
         'asigno la nomenclatura segun la zona
        Ws1.Cells(f1, dia + 9) = zona
10:
      Else
      'No se ha encontrado el IDRH y ORDEN, no hago nada
      End If
    Next
    'deshago autofiltro y busco el siguiente de la hoja ws1
    .AutoFilter
End With
Next f1
'
ApplicationOn
End Sub

Moisés.

Estimado, no olvides que cuando trabajas con hojas distintas y asignas valores a objetos como esas mismas hojas o rangos, pues no debes olvidar a ninguno. Entonces:

Set rng = ws1.Range("A1:J" & uf2)

o

Set rng =ws2 Range("A1:J" & uf2)

Lo mismo para rng1.

Para recorrer celdas  filtradas, vas bien, prueba así para que entiendas:

For Each celda In rng.SpecialCells(xlCellTypeVisible)
    Debug.Print celda.Address
Next celda

Abraham Valencia 

Hola Abraham.

Pues he hecho como dices y ya funciona. He puesto nombre de las hojas bien.

Set rng1 = Ws2.Range("A2:A" & uf2)
    For Each celda In rng1.SpecialCells(xlCellTypeVisible)

He podido ver el funcionamiento en la ventana de inmediato.

Debug.Print celda.Address

He sustituido tal y como me dijiste con las fechas

dia = Val(Left(Ws2.Cells(fila, 6), 2))

por esta linea.

dia = Day(Ws2.Cells(fila, 6))

Al iniciar la macro por si acaso me he dejado puesto el filtro he añadido esto.

If Ws2.AutoFilterMode Then Ws2.AutoFilterMode = 0

Para evitar que saltara un error cuando el campo en la hoja Ws1 tenía un cero a la izquierda y el mismo número no lo tuviera en la hoja Ws2, he modificado esta línea.

IDRH = Val(Ws1.Range("A" & f1))

Antes me ha saltado un error al no encontrar nada en el filtro, es decir no había nada debajo del filtro. Era por esto que digo que en la hoja Ws1 tenia "09850" mientras en la Ws2 tenía "9850". Al no encontrar el valor saltó el error. Lo he solucionado quitando el cero de la izquierda. Pero, ¿se puede prever que no encuentre nada en el filtro y continúe con el siguiente del "For / Next".

Entiendo que la clave pasa por depurar esta línea, sin romper nada. 

If Not celda.value = "" And celda.Row > 1 Then

 

Creo que sería lo último para pulir el código.

Muchas gracias por toda tu ayuda!!

Moisés.

 

No me queda claro lo del filtro, el For con SpecialCells(xlCellTypeVisible) se supone hará que solo se recorran las filas a las que se les aplicó el filtro por ende no debería haber vacías ¿o algo se me está pasando?

Abraham Valencia

Hola de nuevo.

Abraham, te explico.

En la primera hoja, Ws1 "Instaladores", hay una lista de personas con su ID_RH. Con un bucle recorro esa lista uno a uno

For f1 = 7 To uf1
IDRH = Val(Ws1.Range("A" & f1)): ORDEN = Ws1.Range("B" & f1).value

y los busco en la segunda hoja, Ws2 "PartePnetInst". Según el campo "ID_RH" y "Orden" de la primera hoja

.AutoFilter Field:=1, Criteria1:=IDRH
.AutoFilter Field:=2, Criteria1:=ORDEN

filtro en la segunda que coincidan . En principio los ID de la primera deben existir en la segunda. Pero pudiera ocurrir que en la primera tuviera alguna persona de más que ya no esté en la segunda, así que al filtrar con el

For Each celda In rng1.SpecialCells(xlCellTypeVisible)

 no de resultado. Ahí es donde puede ocurrir el error y no se como tenerlo previsto.

 No se si he logrado explicarlo bien.

Gracias Abraham.

 

Hummm... sugiero un intento más del siguiente modo:

- Reenvía el archivo con las últimas modifiaciones que has hecho

- Incluye una explicación real de lo que quieres, es decir, no con variables, imagínate (por favor) que no tienes la macro y comenta que valores se filtran y que valores se compara y que necesitas que ocurra. Incluso si en otra hoja muestres el resultado que querrías sería genial

- Ojo con algo, tus rango ocupan varias filas y columnas, se recorre cada celda de ellas, si el interés es comparar solo algunas celdas ¿por qué recorres tantas celdas que no tienen nada que ver?

Abraham Valencia 

Saludos @Pirtrafilla, y el amigo @avalencia, te dejo un código de como lo haría yo

 

Sub PegarJornadasPnetInst()
    ApplicationOff
    '
    'declaro variables
    Dim uf1, uf2, f1 As Long
    Dim IDRH, ORDEN As String
    Dim celda As Range, rng As Range
    Dim NumIDRH As Long
    Dim NumOrden As Integer
    Dim nFilaWS1 As Double
    
    'asigno las hojas
    Set Ws1 = Sheets("Instaladores"): Set Ws2 = Sheets("PartePnetInst")
    
    'ultima fila de hojas
    uf1 = Ws1.Range("A" & Rows.Count).End(xlUp).Row: uf2 = Ws2.Range("A" & Rows.Count).End(xlUp).Row
    'Set rng = Ws2.Range("A2:A" & uf2)
    
    'ordeno los datos de la hoja 2 para asegurar que esten ordenado por el campo Id. HR
    ActiveWorkbook.Worksheets("PartePnetInst").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("PartePnetInst").Sort.SortFields.Add Key:=Range( _
        "A2:A" & uf2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("PartePnetInst").Sort.SortFields.Add Key:=Range( _
        "B2:B" & uf2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("PartePnetInst").Sort.SortFields.Add Key:=Range( _
        "F2:F" & uf2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("PartePnetInst").Sort
        .SetRange Range("A1:J" & uf2)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'recorro cada fila de la hoja ws2
    NumIDRH = 0
    NumOrden = 0
    For Each celda In Ws2.Range("A2:A" & uf2)
        'cada vez que cambie el campo Id. HR, o el ORDEN busco la fila respectiva en la hoja 1
        If CLng(celda.Value) <> NumIDRH Or CLng(celda.Offset(0, 1).Value) <> NumOrden Then
            nFilaWS1 = 0
            For f1 = 7 To uf1
                If CDbl(Ws1.Range("A" & f1).Value) = CLng(celda.Value) And _
                    CInt(Ws1.Range("B" & f1).Value) = CLng(celda.Offset(0, 1).Value) Then
                    'obtengo los datos necesarios, el numero de fila (NumIDRH)
                    'el orden (NumOrden) y la zona (zona) ya que eso NO cambia
                    'hasta el proximo Id. HR
                    NumIDRH = CDbl(Ws1.Range("A" & f1).Value)
                    NumOrden = CInt(Ws1.Range("B" & f1).Value)
                    nFilaWS1 = f1
                    zona = Ws1.Cells(f1, 8)
                    Select Case zona
                        Case "BARNA"
                            zona = "BS"
                        Case "MANRESA"
                            zona = "TM"
                        Case "Especiales"
                            zona = "BS"
                    End Select
                    Exit For
                End If
            Next f1
        End If
        
        'cargamos la información solo si se consiguio el Id. HR en la hoja 1
        If nFilaWS1 <> 0 Then
            dia = Day(celda.Offset(0, 5).Value)
            'cargamos la info en la hoja Ws1 solo si el día no es S o F
            If Ws1.Cells(5, dia + 9) <> "S" And Ws1.Cells(5, dia + 9) <> "F" Then
                'asigno la nomenclatura segun la zona
                Ws1.Cells(nFilaWS1, dia + 9) = zona
            End If
        End If
    Next
    
End Sub

hace exactamente lo mismo que tu codigo y mucho más rápido claro, suerte.

la forma que lo haces, filtrando y quitando filtros (lo haces la x cantidad de datos que tengas en la hoja "Instaladores") pues consume mucho tiempo, entonces la idea principal que aporto es simplemente ordenar los datos de la hoja "PartePnetInst" y buscas el dato en la hoja "Instaladores" solo cuando cambie el Id. HR o Orden que estes procesando.

 

suerte

@bigpetroman, fantástico. Excelente idea.

En 16/2/2019 at 22:55 , bigpetroman dijo:

ordenar los datos de la hoja "PartePnetInst" y buscas el dato en la hoja "Instaladores"

El código apenas tarda 2 segundos, ciertamente muy inferior al que había preparado.

Muy agradecido.

Moisés.