Ciertamente desconozco totalmente sobre VBA, por ello acudo a ustedes. Necesito en una hoja de calculo, poseer una lista despegable (Validación de Datos) con selección múltiple. He encontrado un código VBA en la WEB y funciona según lo que necesito, no obstante, el código aplica a todas las celdas de la hojas, quisiera me ayuden a establecer su funcionamiento en una hoja especifica ("Morbi-Covid Trebol") y a un rango especifico ("R2:R2000") que corresponde a la Columna "SINTOMAS".
Acá les dejo el código:
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2019/11/13
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
If Target.Count > 1 Then Exit Sub
On Error Resume Next
Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False
If Not Application.Intersect(Target, xRng) Is Nothing Then
xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" Then
If xValue2 <> "" Then
If xValue1 = xValue2 Or _
InStr(1, xValue1, "; " & xValue2) Or _
InStr(1, xValue1, xValue2 & ",") Then
Target.Value = xValue1
Else
Target.Value = xValue1 & "; " & xValue2
End If
End If
End If
End If
Application.EnableEvents = True
End Sub
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Hola a todos. Saludos, agradezco el tiempo de cada uno y aporte al tema.
Morbilidad 2021.xlsm
Ciertamente desconozco totalmente sobre VBA, por ello acudo a ustedes. Necesito en una hoja de calculo, poseer una lista despegable (Validación de Datos) con selección múltiple. He encontrado un código VBA en la WEB y funciona según lo que necesito, no obstante, el código aplica a todas las celdas de la hojas, quisiera me ayuden a establecer su funcionamiento en una hoja especifica ("Morbi-Covid Trebol") y a un rango especifico ("R2:R2000") que corresponde a la Columna "SINTOMAS".
Acá les dejo el código:
Private Sub Worksheet_Change(ByVal Target As Range) 'Updated by Extendoffice 2019/11/13 Dim xRng As Range Dim xValue1 As String Dim xValue2 As String If Target.Count > 1 Then Exit Sub On Error Resume Next Set xRng = Cells.SpecialCells(xlCellTypeAllValidation) If xRng Is Nothing Then Exit Sub Application.EnableEvents = False If Not Application.Intersect(Target, xRng) Is Nothing Then xValue2 = Target.Value Application.Undo xValue1 = Target.Value Target.Value = xValue2 If xValue1 <> "" Then If xValue2 <> "" Then If xValue1 = xValue2 Or _ InStr(1, xValue1, "; " & xValue2) Or _ InStr(1, xValue1, xValue2 & ",") Then Target.Value = xValue1 Else Target.Value = xValue1 & "; " & xValue2 End If End If End If End If Application.EnableEvents = True End Sub