Lista desplegable dependiente de una función SI
Tengo unas celdas (pongamos como ejemplo, de C4:C18) con una función SI, de forma que me devuelve un valor. En las celdas contiguas (D4:D18) pretendo lo siguiente: que si el valor de la celda C4 es del 1 al 4, que en la celda D4 me salga una lista desplegable para poner un número desde el 1 al 6; pero si el valor está entre el 5 y el 10 (ambos incluidos), que simplemente (y de forma automática) me ponga ese valor, sin necesidad de hacer nada. Son varios los pares de columnas que tengo con las mismas características. No sé si se puede hacer con funciones normales o hay que utilizar VBA, en cualquier caso, no sé cómo hacerlo. Agradezco de antemano a todos aquellos que tengan a bien dedicarme su tiempo.
1 respuesta
Se tiene que hacer con código VBa (una macro).
Sigue las Instrucciones para poner la macro en worksheet
1. Abre tu hoja de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
4. Del lado derecho copia la macro
Private Sub Worksheet_Calculate()
'Por.DAM
Application.EnableEvents = False
Application.ScreenUpdating = False
activa = ActiveCell.Address
'Para la pareja de columnas C y D
For Each celda In Range("C4:C18")
f = celda.Row
If celda >= 1 And celda <= 4 Then
Cells(celda.Row, celda.Column + 1).Select
ponval
End If
If celda >= 5 And celda <= 10 Then
Cells(celda.Row, celda.Column + 1).Select
ponnum celda.Value
End If
Next
'Para la pareja de columnas E y F
For Each celda In Range("E4:E18")
f = celda.Row
If celda >= 1 And celda <= 4 Then
Cells(celda.Row, celda.Column + 1).Select
ponval
End If
If celda >= 5 And celda <= 10 Then
Cells(celda.Row, celda.Column + 1).Select
ponnum celda.Value
End If
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
Range(activa).Select
End Sub
Sub ponval()
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="1,2,3,4,5,6"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Selection = ""
End Sub
Sub ponnum(c)
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Selection = c
End SubTe puse 2 ejemplos de pares de columnas. si quieres agregar otro par tienes que copiar esta parte:
'Para la pareja de columnas E y F
For Each celda In Range("E4:E18")
f = celda.Row
If celda >= 1 And celda <= 4 Then
Cells(celda.Row, celda.Column + 1).Select
ponval
End If
If celda >= 5 And celda <= 10 Then
Cells(celda.Row, celda.Column + 1).Select
ponnum celda.Value
End If
NextDespués de que la copies, cambia las letras en esta línea
For Each celda In Range("E4:E18")
Por ejemplo si quieres la pareja G y H, te debe quedar así
For Each celda In Range("G4:G18")
Saludos. DAM
Si es lo que necesitas.
