Código para lista desplegable con descripción para panilla en excel
Tengo un libro de excel con varias hojas una de ella se llama "código y listas" y otra "planilla"
La Hoja planilla tiene un macro que hace que todo lo que se escriba quede en mayuculas sostenida excepto la celda del correo electrónico
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
Application.EnableEvents = False
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("Z1:Z5000")) Is Nothing Then
Target = UCase(Target)
Else
Target = LCase(Target)
End If
Application.EnableEvents = True
End Sub
Adicional a esto la hoja tiene celdas con validación de datos en listas desplegables, pero solo muestra unos códigos los cuales hay que consulta en la hoja "lista y códigos" donde esta la descripción de cada uno para seleccionar el que se necesita, lo que necesito es que no sea necesario consultarlos ; es decir que en la lista desplegable me muestre la descripción y al elegir la que se necesita me refleje el código que le corresponde
D2
Cod grupocuentas
K002 Personas naturales
K003 Personas Jurídicas
K004 Extranjeros
K005 Entes públicos
K006 Empleados
O sea que si escojo"PERSONA NATURALES" me debería mostrar "K002" los mismo requiero con las celdas E2=TRATAMIENTO, P2=PAISSAP, Q2=DEPARTAMENTO, AD2=TIPOSAP, AE2=CLASEDEIMPUESTO, AJ2=BANCO, AM2=CLASECUENTA.
1 Respuesta
Hola
Seria así
En la hoja "planilla" en la columna D voy a poner la lista desplegable; esta lista desplegable corresponde a los datos que están en la hoja "código y listas" "D16:E20"
Plantilla código lista
D D16:E20
P A35:B289
Q C36:D69
AD D2:E12
AE F23:G24
AJ A2:B32
AU F31:G32
AW F36:G42
Muchas gracias
Te anexo la macro
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Row = 1 Then Exit Sub
'
Application.EnableEvents = False
If Intersect(Target, Range("Z1:Z5000")) Is Nothing Then
Target = UCase(Target)
Else
Target = LCase(Target)
End If
'
cols = Array("D", "P", "Q", "AD", "AE", "AJ", "AM", "AW")
noms = Array("GRUPOCUENTA", "PAISES", "DEPARTAMENTOS", "TIPOSAP", _
"CLASEIMPUESTO", "BANCOS", "CLASECUENTA", "GRUPOTESORERIA")
For i = LBound(cols) To UBound(cols)
If Not Intersect(Target, Columns(cols(i))) Is Nothing Then
Call PonerCodigo(Target, noms(i))
Exit For
End If
Next
Application.EnableEvents = True
End Sub
'
Sub PonerCodigo(Target, rango)
'Por.Dante Amor
Set b = Sheets("Bancos y Departamentos").Range(rango).Find(Target, lookat:=xlWhole)
If Not b Is Nothing Then
cod = b.Offset(0, -1)
Application.EnableEvents = False
With Target.Validation
.Delete
Target.Value = cod
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=" & rango
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Application.EnableEvents = True
End If
End Sub':) ':)
