Excel - Crear casilla desplegable selección múltiple

Necesito crear una pequeña base de datos para la cooperativa. En ella tengo las filas con los personas y en las columnas una serie de datos. En una de las columnas necesito poner el área al que se va a asignar a la persona, pero el problema es que en algunas ocasiones necesito que se las asigne a varias áreas.

Necesitaría que al pinchar sobre la celda se me despliegue una lista de la que pueda seleccionar varias opciones y queden recogidas dentro de la casilla como texto separadas por comas.

Es importante que quede dentro de las casillas porque luego necesito exportarlo a otra hoja para poder hacer informes individuales. Si hay que hacer un cuadro de ActiveX para poder hacer esto necesitaría, primero, que éste traslade la información a la casilla, segundo, que pueda repetirse el cuadro cientas de veces sin que lleve cientas de horas.

Llevo tiempo buscando por internet y no he conseguido una solución aún.

Respuesta
1

H o l a: Lo mejor, por ser más dinámico, sería crear un userform.

Realiza los siguientes pasos:

  1. Crea una hoja con el nombre de "areas"
  2. En la hoja "areas" en la columna "A" desde la fila 1 y hacia abajo pon los nombres de las áreas

  3. Crea un UserForm.

    Instrucciones para UserForm

    1. Abre tu archivo de excel
    2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
    3. En el menú elige Insertar / UserForm
    4. En el panel del UserForm creas un Listbox, que se llame ListBox1
    5. Creas un commandbutton1 para "Actualizar" y otro commandbutton2 para "Cancelar"

    6. Le das dobleclik al listbox y copias el siguiente código:
      Private Sub CommandButton1_Click()
      'Por.Dante Amor
          For j = 0 To ListBox1.ListCount - 1
              If ListBox1.Selected(j) Then
                  cad = cad & ListBox1.List(j) & ","
              End If
          Next
          If cad <> "" Then
              cad = Left(cad, Len(cad) - 1)
              ActiveCell.Value = cad
          End If
          Unload Me
      End Sub
      '
      Private Sub CommandButton2_Click()
          Unload Me
      End Sub
      '
      Private Sub UserForm_Activate()
      'Por.Dante Amor
          Set h2 = Sheets("areas")
          u = h2.Range("A" & Rows.Count).End(xlUp).Row
          ListBox1.MultiSelect = fmMultiSelectMulti
          ListBox1.ListStyle = fmListStyleOption
          ListBox1.RowSource = h2.Name & "!A1:A" & u
          '
          valor = ActiveCell.Value
          If valor <> "" Then
              cad = Split(valor, ",")
              For i = LBound(cad) To UBound(cad)
                  area = WorksheetFunction.Trim(cad(i))
                  For j = 0 To ListBox1.ListCount - 1
                      If area = ListBox1.List(j) Then
                          ListBox1.Selected(j) = True
                      End If
                  Next
              Next
          End If
      End Sub
  4. En los eventos de la hoja pon el siguiente código. 

    Sigue las Instrucciones para poner la macro en los eventos de worksheet

    1. Abre tu libro 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. En el panel del lado derecho copia la macro
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      'Por.Dante Amor
          If Not Intersect(Target, Columns("D")) Is Nothing Then
              If Target.Count > 1 Then Exit Sub
              UserForm1.Show
          End If
      End Sub
    5. Cambia en la macro anterior "D" por la columna donde quieras poner las áreas.
  5. Guarda tu archivo habilitado para macros.
  6. Ahora, en la hoja donde vas a capturar la áreas, selecciona una celda de la columna "D" o de la columna que hayas puesto en la macro. En automático se abrirá el userform y podrás seleccionar una o varias áreas, presiona Actualizar, para pasar las áreas, separadas por comas, a la celda.
  7. Cada que selecciones una celda, te mostrará el userform, si la celda ya tiene áreas, en el listbox podrás ver las áreas, podrás agregar o quitar áreas.

Avísame si tienes dudas. 

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Hola Dante,

Lo primero agradecerte de corazón tu ayuda, funciona muy bien. Estuve ayer adaptándolo al formato de base de datos que tenía pero como me daba fallos al final la he empezado de nuevo y construiré el resto en torno a esta función. 

Otra pregunta: si quiero que en vez de empezar la función en la casilla 1 de la columna D empiece en la 7 ¿cómo lo hago?

Cambia la macro del evento por esta:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Por.Dante Amor
    If Not Intersect(Target, Columns("D")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        if target.row < 7 then exit sub
        UserForm1.Show
    End If
End Sub

sal u dos

Muchísimas gracias Dante. Funciona a la perfección :D

Por si alguien lo utiliza y le da errores, si cambiáis el nombre de las hojas ajustadlo en el macro, y si queréis un espacio después de la coma tan sólo tenéis que introducirlo en el macro.

Me gustaría que la coma que introduce después de cada palabra la introduzca sólo si hay otra palabra a continuación. Es decir, si elijo una opción que no haya coma, si elijo 2 una en medio, etc. ¿Es posible?

La macro quita la última coma con estas instrucciones

    If cad <> "" Then
        cad = Left(cad, Len(cad) - 1)
        ActiveCell.Value = cad
    End If

Pero supongo, por tus comentarios, que modificaste la macro. Pero no sé qué modificaste, por lo tanto no podría arreglarlo.

Si trabajas con la macro original, NO pone la última coma.

Sí, la modifiqué para que añadiese un espacio después de la coma (nada más), poniendo un espacio en ", "

For j = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(j) Then
cad = cad & ListBox1.List(j) & ", "
End If

Ahora me pone comas al final. ¿Hay alguna forma de conseguir ambas cosas? Que ponga coma + espacio y borre la última coma.

Olvídalo, tan sólo tenía que cambiar -1 por -2. ¡Muchas gracias Dante!

Cambia esta línea:

cad = Left(cad, Len(cad) - 1)

Por esta

cad = Left(cad, Len(cad) - 2)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas