Conversión de una macro ejecutable en cambio de dato en hoja
Quisiera ver si me pueden ayudar con esto..
Quiero convertir esta macro (no busque como volverla más rápida) de aquí:
Sub FuncionBuscarv()
'Por.Dante Amor
Set h1 = Sheets("IMPRESION") ' HOJA QUE BUSCAR
Set h2 = Sheets("HOJA DE SUELDOS") ' HOJA DE DONDE BUSCAR
dato = h1.Range("C2") 'QUE BUSCAR
res = Application.VLookup(dato, h2.Range("A:AA"), 2, False)
res2 = Application.VLookup(dato, h2.Range("A:AA"), 3, False)
res3 = Application.VLookup(dato, h2.Range("A:AA"), 4, False)
res4 = Application.VLookup(dato, h2.Range("A:AA"), 5, False)
res5 = Application.VLookup(dato, h2.Range("A:AA"), 6, False)
res6 = Application.VLookup(dato, h2.Range("A:AA"), 7, False)
res7 = Application.VLookup(dato, h2.Range("A:AA"), 8, False)
res8 = Application.VLookup(dato, h2.Range("A:AA"), 9, False)
res9 = Application.VLookup(dato, h2.Range("A:AA"), 10, False)
res10 = Application.VLookup(dato, h2.Range("A:AA"), 11, False)
res11 = Application.VLookup(dato, h2.Range("A:AA"), 12, False)
res12 = Application.VLookup(dato, h2.Range("A:AA"), 13, False)
res13 = Application.VLookup(dato, h2.Range("A:AA"), 14, False)
res14 = Application.VLookup(dato, h2.Range("A:AA"), 15, False)
res15 = Application.VLookup(dato, h2.Range("A:AA"), 16, False)
res16 = Application.VLookup(dato, h2.Range("A:AA"), 17, False)
res17 = Application.VLookup(dato, h2.Range("A:AA"), 18, False)
res18 = Application.VLookup(dato, h2.Range("A:AA"), 19, False)
res19 = Application.VLookup(dato, h2.Range("A:AA"), 20, False)
res20 = Application.VLookup(dato, h2.Range("A:AA"), 21, False)
res21 = Application.VLookup(dato, h2.Range("A:AA"), 22, False)
res22 = Application.VLookup(dato, h2.Range("A:AA"), 25, False)
If IsError(res) = True Then
h1.Range("J3") = "No existe"
Else
h1.Range("J3") = res 'NOMBRE
h1.Range("J4") = res2 'DEPTO
h1.Range("J5") = res3 'SEMANA
h1.Range("J6") = res4 ' PERIODO
h1.Range("J7") = res5 'SUELDO NOMINA
h1.Range("J8") = res6 'COMPLEMENTO
h1.Range("J9") = res7 'SEPTIMO
h1.Range("J10") = res8 'TUNRO DE NOCHE
h1.Range("J11") = res9 'DIA FESTIVO
h1.Range("J12") = res10 ' NO ASEG
h1.Range("J13") = res11 'SUPLENCIAS
h1.Range("J14") = res12 'VACACIONES Y PRIMA
h1.Range("J15") = res13 'VACA TRABAJDAS
h1.Range("J16") = res14 ' COMIDA
h1.Range("J17") = res15 ' TRANSPORTE
h1.Range("J18") = res16 'EXTRAS
h1.Range("J19") = res17 'COMPLEMENTO
h1.Range("J20") = res18 'GRATIFICACION
h1.Range("J21") = res19 'INCENTIVOS
h1.Range("J22") = res20 'TOTAL A PAGAR
h1.Range("J23") = res21 'NOMINA
h1.Range("J24") = res22 'DESCUENTO
End If
End Subdentro de aqui:
Private Sub Worksheet_Change(ByVal Target As Range) End Sub
1 Respuesta
Respuesta de Dante Amor
1
Te anexo la macro
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Address(False, False) <> "C2" Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Count > 1 Then Exit Sub
'
Set h1 = Sheets("IMPRESION") ' HOJA QUE BUSCAR
Set h2 = Sheets("HOJA DE SUELDOS") ' HOJA DE DONDE BUSCAR
dato = h1.Range("C2") 'QUE BUSCAR
Set b = h2.Columns("A").Find(dato, lookat:=xlWhole, LookIn:=xlValues)
If b Is Nothing Then
h1.Range("J3") = "No existe"
Else
H1.Range("J3") = h2. Cells(b. Row, 2) 'NOMBRE
h1.Range("J4") = h2. Cells(b. Row, 3) 'DEPTO
h1.Range("J5") = h2. Cells(b. Row, 4) 'SEMANA
h1.Range("J6") = h2. Cells(b. Row, 5) ' PERIODO
h1.Range("J7") = h2. Cells(b. Row, 6) 'SUELDO NOMINA
h1.Range("J8") = h2. Cells(b. Row, 7) 'COMPLEMENTO
h1.Range("J9") = h2. Cells(b. Row, 8) 'SEPTIMO
h1.Range("J10") = h2. Cells(b. Row, 9) 'TUNRO DE NOCHE
h1.Range("J11") = h2. Cells(b. Row, 10) 'DIA FESTIVO
h1.Range("J12") = h2. Cells(b. Row, 11) ' NO ASEG
h1.Range("J13") = h2. Cells(b. Row, 12) 'SUPLENCIAS
h1.Range("J14") = h2. Cells(b. Row, 13) 'VACACIONES Y PRIMA
h1.Range("J15") = h2. Cells(b. Row, 14) 'VACA TRABAJDAS
h1.Range("J16") = h2. Cells(b. Row, 15) ' COMIDA
h1.Range("J17") = h2. Cells(b. Row, 16) ' TRANSPORTE
h1.Range("J18") = h2. Cells(b. Row, 17) 'EXTRAS
h1.Range("J19") = h2. Cells(b. Row, 18) 'COMPLEMENTO
h1.Range("J20") = h2. Cells(b. Row, 19) 'GRATIFICACION
h1.Range("J21") = h2. Cells(b. Row, 20) 'INCENTIVOS
h1.Range("J22") = h2. Cells(b. Row, 21) 'TOTAL A PAGAR
h1.Range("J23") = h2. Cells(b. Row, 22) 'NOMINA
h1.Range("J24") = h2. Cells(b. Row, 25) 'DESCUENTO
End If
End SubNota: Si una macro va firmada con mi nombre, debo buscar que sea una macro eficiente, es cuestión de ética, no puedo permitir que una de mis macros no esté bien realizada, ordenada y eficiente.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
