Adecuar código a un rango de filas y columnas en especifico y que solo acepte ciertos criterios
Tengo un rango donde colocare estas iniciales de letras
A
B
P
I
El rango es: D17:AL100
Entonces en ese rango en esas filas y en esas columnas quisiera adaptar el siguiente código que estoy actualizando a mis necesidades.
Este es el código, actualmente solo funciona en la col 4 osea la col DE pero quisiera que abarque las columnas del rango mencionado y además solo me permita colocar las letras que describí
Private Sub Worksheet_Change(ByVal Target As Range)
'Dim Fila As Integer, Columna As Integer, UltimaFila As Integer
'Dim Permiso As String, Constancia As String, Cuando As String
Columna = Target.Column
If Columna = 4 Then
Fila = Target.Row
If Cells(Fila, Columna) = "I" Then
With Sheets("Reporte")
UltimaFila = .Range("C" & Rows.Count).End(xlUp).Row
UNO = InputBox("¿Trajo receta?", "INCAPACIDADES") 'AQUI 1 INPUTBOX
If UNO = Empty Then
MsgBox "*" & Target & "*" & " Incidencia eliminada. Dia: " & Sheets("AGOSTO").Cells(16, Target.Column), , Range("B" & Target.Row)
Target = Empty
Else
DOS = InputBox("¿Tipo de receta: IMSS o PARTICULAR?", "INCAPACIDADES") 'AQUI 2 INPUTBOX
If DOS = Empty Then
MsgBox "*" & Target & "*" & " Incidencia eliminada. Dia: " & Sheets("AGOSTO").Cells(16, Target.Column), , Range("B" & Target.Row)
Target = Empty
Else
TRES = InputBox("¿Dias que le dieron?", "INCAPACIDADES") 'AQUI 3 INPUTBOX
If TRES = Empty Then
MsgBox "*" & Target & "*" & " Incidencia eliminada. Dia: " & Sheets("AGOSTO").Cells(16, Target.Column), , Range("B" & Target.Row)
Target = Empty
Else
CUATRO = InputBox("¿Cuando se reincorpora?", "INCAPACIDADES") 'AQUI 4 INPUTBOX
If CUATRO = Empty Then
MsgBox "*" & Target & "*" & " Incidencia eliminada. Dia: " & Sheets("AGOSTO").Cells(16, Target.Column), , Range("B" & Target.Row)
Target = Empty
Else
.Cells(UltimaFila + 1, 2) = Sheets("AGOSTO").Range("B" & Target.Row) 'COLABORADOR
.Cells(UltimaFila + 1, 3) = Sheets("AGOSTO").Range("C" & Target.Row) ' CARGO
.Cells(UltimaFila + 1, 4) = Target 'CLAVE DE INCIDENCIA
.Cells(UltimaFila + 1, 5) = Sheets("AGOSTO").Cells(16, Target.Column) & _
" " & Sheets("AGOSTO").Cells(14, Target.Column) ' DIA DE INCIDENCIA
.Cells(UltimaFila + 1, 6) = Date 'FECHA DE CAPTURA
.Cells(UltimaFila + 1, 7) = UNO
.Cells(UltimaFila + 1, 8) = DOS
.Cells(UltimaFila + 1, 9) = TRES
.Cells(UltimaFila + 1, 10) = CUATRO
OB = InputBox("Observaciones o comentarios adicionales.", "OPCIONAL") 'OBSERVACIONES
.Cells(UltimaFila + 1, 31) = OB
MsgBox "Datos registrados", vbInformation, "INCIDENCIAS"
End If
End If
End If
End If
End With
End If
End Sub
1 Respuesta
Te anexo la macro. Para validar las letra utiliza la lista de validación
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Not Intersect(Target, Range("D17:AL100")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Set h = Sheets("Reporte")
UNO = InputBox("¿Trajo receta?", "INCAPACIDADES") 'AQUI 1 INPUTBOX
If UNO <> Empty Then
DOS = InputBox("¿Tipo de receta: IMSS o PARTICULAR?,Anota el folio:", "INCAPACIDADES") 'AQUI 2 INPUTBOX
If DOS <> Empty Then
TRES = InputBox("¿Dias que le dieron?", "INCAPACIDADES") 'AQUI 3 INPUTBOX
If TRES <> Empty Then
CUATRO = InputBox("¿Cuando se reincorpora?", "INCAPACIDADES") 'AQUI 4 INPUTBOX
If CUATRO <> Empty Then
u = h.Range("C" & Rows.Count).End(xlUp).Row + 1
h.Cells(u, 2) = Sheets("AGOSTO").Range("B" & Target.Row) 'COLABORADOR
h.Cells(u, 3) = Sheets("AGOSTO").Range("C" & Target.Row) ' CARGO
h.Cells(u, 4) = Target 'CLAVE DE INCIDENCIA
h.Cells(u, 5) = Sheets("AGOSTO").Cells(16, Target.Column) & _
" " & Sheets("AGOSTO").Cells(14, Target.Column) ' DIA DE INCIDENCIA
h.Cells(u, 6) = Date 'FECHA DE CAPTURA
h.Cells(u, 7) = UNO
h.Cells(u, 8) = DOS
h.Cells(u, 9) = TRES
h.Cells(u, 10) = CUATRO
OB = InputBox("Observaciones o comentarios adicionales.", "OPCIONAL") 'OBSERVACIONES
h.Cells(u, 31) = OB
MsgBox "Datos registrados", vbInformation, "INCIDENCIAS"
Exit Sub
End If
End If
End If
End If
MsgBox "*" & Target & "*" & " Incidencia eliminada. Dia: " & Sheets("AGOSTO").Cells(16, Target.Column), , Range("B" & Target.Row)
Target = ""
End If
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Hola dan si me funciono excelente, pero por cuestiones de todoexpertos no te pude colocar todo mi código, el cual era algo así:
A =asistencia y sus 4 inputbox
B = baja y sus 4 inputbox diferentes a los de A
I = incapacidad y sus 4 inputbox diferentes a los A y alos B
Y así con las demás incidencias que tengo puesto.
Espero me puedas ayudar abriré otra pregunta y valorare esta gracias
Puedes poner un Select Case y por cada letra poner tus input
R ecuerda valorar, para pasar a la siguiente pregunta
