Saltar al contenido

Seleccionar varios elementos de la lista desplegable a una celda sin repetición


Recommended Posts

publicado

Buenas tardes tengan todos ustedes, sin encontrar una solución a mi problema hoy acudo a su apoyo. Tengo el siguiente código que me ayuda a seleccionar varios elementos de una lista desplegable:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Integer
    Dim xRgVal As Range
    Dim xStrNew As String
    Dim xStrOld As String
    Dim xFlag As Boolean
    Dim xArr
    Select Case Target.Column
  Case 7
    On Error Resume Next
    Set xRgVal = Cells.SpecialCells(xlCellTypeAllValidation)
    If (Target.Count > 1) Or (xRgVal Is Nothing) Then Exit Sub
    If Intersect(Target, xRgVal) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    xFlag = True
    xStrNew = " " & Target.Value & " "
    Application.Undo
    xStrOld = Target.Value
    If InStr(1, xStrOld, xStrNew) = 0 Then
        xStrNew = xStrNew & xStrOld & " "
    Else
        xStrNew = xStrOld
        End If
    End Select

Target.Value = xStrNew
  Application.EnableEvents = True
End Sub 

Sin embargo con el anterior código ya no me deja borrar datos de la celda donde esta la lista desplegable. 

De antemano gracias por los consejos que podrían darme. 

 

 

publicado

Siguiendo con el hilo modifique el código anterior a: 

Dim rngDV As Range
Dim oldVal As String
Dim newVal As String

'Ejecuta el código sólo si cambia una celda
If Target.Count > 1 Then GoTo exitHandler
  
Select Case Target.Column
  Case 7, 24       
    On Error Resume Next
    'check the cell for data validation
    Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler
    If rngDV Is Nothing Then GoTo exitHandler
    
    If Intersect(Target, rngDV) Is Nothing Then

    Else
        Application.EnableEvents = False
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        Target.Value = newVal
        If oldVal <> "" Then
          If newVal <> "" Then
            Target.Value = oldVal _
              & "- " & newVal
          End If
        End If
    End If

End Select

exitHandler:
  Application.EnableEvents = True

La razón fue que afecta otro código que esta inserto en el evento Private Sub Worksheet_Change. 

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.