Mejorar la macro de buscar un dato en otra hoja y copiarlo en una tercera
Te quiero pedir que me ayudes a mejorar la macro y analizar porque se incrementa tanto el tamaño del archivo haciéndolo que se ralentice su visualización.
El código no funciono ya que solo arranca y se queda con el resultado del primer registro (cosa bien curiosa, si en el archivo anterior si funciona), para lo cual un experto me dio un código mejorado.
Me surgieron varios interrogantes al verlo funcionar
En las siguientes lineas de código:
Se declara las variables donde van a estar las filas a partir donde están los datos de cada hoja
Set Personal = h2.Range("A5").CurrentRegion
Set Novedades = h3.Range("A6").CurrentRegion
Set Nomina = h4.Range("A10").CurrentRegion
Y se declaran unas constantes:
r = .Rows.Count
x = 1 que me toco cambiarla x 5 para que arrancará en la fila que es de la hoja nómina
For i = 1 To r
dato = .Cells(i, 1)
For j = 1 To Personal.Rows.Count la constante j=1 la cambie x j=2 para que no tomara la cabecerá de los datos de la hoja novedades.
Los códigos completos son:
'CODIGO INICIAL QUE DEJO DE FUNCIONAR EN EL NUEVO LIBRO
Sub BuscarEmp()
Application.ScreenUpdating = False
Dim hnov, hpnal, hnom As Integer
hnov = 6
hpnal = 5
hnom = 10
On Error Resume Next
While Sheets("Novedades").Cells(hnov, 1) <> Empty
While Sheets("Personal").Cells(hpnal, 1) <> Empty
dato1 = Sheets("Novedades").Cells(hnov, 1)
dato2 = Sheets("Personal").Cells(hpnal, 1)
If Sheets("Novedades").Cells(hnov, 1) = Sheets("Personal").Cells(hpnal, 1) Then
Sheets("Nomina").Cells(hnom, 2) = Sheets("Personal"). Cells(hpnal, 1)
Sheets("Nomina").Cells(hnom, 3) = Sheets("Personal"). Cells(hpnal, 8)
Sheets("Nomina").Cells(hnom, 4) = Sheets("Personal"). Cells(hpnal, 9)
Sheets("Nomina").Cells(hnom, 5) = Sheets("Personal"). Cells(hpnal, 10)
Sheets("Nomina").Cells(hnom, 6) = Sheets("Personal"). Cells(hpnal, 11)
Sheets("Nomina").Cells(hnom, 7) = Sheets("Personal"). Cells(hpnal, 12)
Sheets("Nomina").Cells(hnom, 8) = Sheets("Personal"). Cells(hpnal, 13)
Sheets("Nomina").Cells(hnom, 9) = Sheets("Personal"). Cells(hpnal, 7)
Sheets("Nomina").Cells(hnom, 10) = Sheets("Personal"). Cells(hpnal, 24)
Sheets("Nomina").Cells(hnom, 11) = Sheets("Personal"). Cells(hpnal, 25)
Sheets("Nomina").Cells(hnom, 12) = Sheets("Personal"). Cells(hpnal, 26)
Sheets("Nomina").Cells(hnom, 13) = Sheets("Personal"). Cells(hpnal, 27)
Sheets("Nomina").Cells(hnom, 14) = Sheets("Personal"). Cells(hpnal, 15)
Sheets("Nomina").Cells(hnom, 33) = Sheets("Personal"). Cells(hpnal, 23)
Sheets("Nomina").Cells(hnom, 15) = Sheets("Novedades"). Cells(hnov, 3)
Sheets("Nomina").Cells(hnom, 16) = Sheets("Novedades"). Cells(hnov, 4)
Sheets("Nomina").Cells(hnom, 20) = Sheets("Novedades"). Cells(hnov, 5)
Sheets("Nomina").Cells(hnom, 26) = Sheets("Novedades"). Cells(hnov, 6)
Sheets("Nomina").Cells(hnom, 27) = Sheets("Novedades"). Cells(hnov, 7)
Sheets("Nomina").Cells(hnom, 32) = Sheets("Novedades"). Cells(hnov, 8)
hnom = hnom + 1
End If
hpnal = hpnal + 1
Wend
hnov = hnov + 1
hpnal = 2
Wend
Application.ScreenUpdating = True
End Sub
2 respuestas
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Veamos si entendí: Tomas un dato de la hoja "novedades" y lo buscas en la hoja "personal", si lo encuentras copias varios datos de "novedades" y "personal" a la hoja "nómina"; es correcto?
Si es así, entonces utiliza la siguiente macro:
Sub BuscarEmp()
'Act.Por Dante Amor
Set h1 = Sheets("Novedades") 'hoja base
Set h2 = Sheets("Personal") 'hoja de búsqueda
Set h3 = Sheets("Nomina") 'hoja destino
j = 10
'
For i = 6 To h1.Range("A" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("A").Find(h1.Cells(i, "A"), lookat:=xlWhole)
If Not b Is Nothing Then
H3.Cells(j, 2) = h2. Cells(b. Row, 1)
H3.Cells(j, 3) = h2. Cells(b. Row, 8)
H3.Cells(j, 4) = h2. Cells(b. Row, 9)
H3.Cells(j, 5) = h2. Cells(b. Row, 10)
H3.Cells(j, 6) = h2. Cells(b. Row, 11)
H3.Cells(j, 7) = h2. Cells(b. Row, 12)
H3.Cells(j, 8) = h2. Cells(b. Row, 13)
H3.Cells(j, 9) = h2. Cells(b. Row, 7)
H3.Cells(j, 10) = h2. Cells(b. Row, 24)
H3.Cells(j, 11) = h2. Cells(b. Row, 25)
H3.Cells(j, 12) = h2. Cells(b. Row, 26)
H3.Cells(j, 13) = h2. Cells(b. Row, 27)
H3.Cells(j, 14) = h2. Cells(b. Row, 15)
H3.Cells(j, 33) = h2. Cells(b. Row, 23)
h3.Cells(j, 15) = h1.Cells(i, 3)
h3.Cells(j, 16) = h1.Cells(i, 4)
h3.Cells(j, 20) = h1.Cells(i, 5)
h3.Cells(j, 26) = h1.Cells(i, 6)
h3.Cells(j, 27) = h1.Cells(i, 7)
h3.Cells(j, 32) = h1.Cells(i, 8)
j = j + 1
End If
Next
MsgBox "Fin"
End SubAlgunas recomendaciones:
- No utilices la instrucción On Error Resume Next, lo conveniente es controlar los posibles errores. Además si la macro falla no sabrás en cuál línea tienes el problema, ya que lo que hace la instrucción es, en caso de error, pasar a la siguiente línea, y la macro nunca se detiene.
- En vba no es necesario declarar las variables, todas las variables se declaran por default como Variant, si lo vas a hacer, debe ser de la forma correcta, en esta línea solamente estás declarando hnom como Integer
Dim hnov, hpnal, hnom As Integer
- Lo correcto debe ser:
Dim hnov As Integer, hpnal As Integer, hnom As Integer
- Pero como ya te comenté, no es necesario que las declares, revisa lo siguiente:
- Según su función ¿Cómo declarar variables?
¡Gracias! Funciona perfecto y es mas claro entender la lógica de pasos que sigue el código.
Me queda es otra inquietud con respecto al porque del incremento en el tamaño del archivo según los ejemplos enviados al correo. Pero bueno eso lo haré en otra pregunta. Mil gracias.
Eres un Experto de categoría Genio!!!
