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.
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
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.