Datos en validación de Validación de datos en la celda B2
Tengo una consulta más referente a la pregunta, he realizado en cada uno de las celdas, el formato condicional manualmente, eso ya quedo bien, y también he copiado la macro en la hoja “Ent Herr y Tec Sal”, cuando le doy por ejemplo en la celda B2 entradas y salidas desaparecen más de 10 en las celdas AH1 al AH192, cuando solo debería de desaparecer uno solo, tú crees que me puedas ayudar, existe solo esta macro
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
'
Set celdas = Range("B2:B193")
If Not Intersect(Target, celdas) Is Nothing Then
Sheets("Data").Columns("AH").Clear
j = 1
For Each r In Sheets("Data").Range("AG1:AG192")
existe = False
For Each c In celdas '.SpecialCells(xlCellTypeConstants, 23)
If c.Address <> Target.Address Then
If r.Value = c.Value Then
existe = True
Exit For
End If
End If
Next
If existe = False Then
Sheets("Data").Cells(j, "AH") = r.Value
j = j + 1
End If
Next
'
u2 = Sheets("Data").Range("AH" & Rows.Count).End(xlUp).Row
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="=Data!AH1:AH" & u2
.IgnoreBlank = True: .InCellDropdown = True
.InputTitle = "": .ErrorTitle = ""
.InputMessage = "": .ErrorMessage = ""
.ShowInput = True: .ShowError = True
End With
End If
End Sub
1 Respuesta
H o l a:
Te anexo la macro actualizada
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Then Exit Sub
'
Set celdas = Range("B2:B193")
If Not Intersect(Target, celdas) Is Nothing Then
Set h = Sheets("Data")
h.Columns("AG").Copy h.Columns("AH")
j = 1
For Each c In celdas
If c.Value <> "" Then
Set b = h.Columns("AH").Find(c.Value, lookat:=xlWhole)
If Not b Is Nothing Then
h.Cells(b.Row, "AH").Delete Shift:=xlUp
End If
End If
Next
'
u2 = Sheets("Data").Range("AH" & Rows.Count).End(xlUp).Row
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="=Data!AH1:AH" & u2
.IgnoreBlank = True: .InCellDropdown = True
.InputTitle = "": .ErrorTitle = ""
.InputMessage = "": .ErrorMessage = ""
.ShowInput = True: .ShowError = True
End With
End If
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
Tienes pendiente valorar esta respuesta. G r a ci as
