Modificar Macros por agregar columnas
Nos hicieron falta 3 columnas...
En este nuevo archivo:
1.- Agregue la Columna B y C, que una vez ingresado el dato en la G, deben de ser bloqueadas.
2.- Agregue la columna QUE, que tiene una fórmula, que debe de irse actualizando conforme se van agregando filas.
Pero además, hay que "recorrer" para actualizar las macros, porque no se actualizan en automático...
¿Te puedo molestar con tu ayuda?
1 respuesta
Te anexo la macro, creo que lo más conveniente es que se actualice todo hasta que capturas el dato de la columna G.
Pero revisa el resultado y me comentas.
Private Sub Worksheet_Change(ByVal Target As Range) 'Por.Dante Amor clave = "abc" ' If Not Intersect(Target, Range("G:G")) Is Nothing Then ActiveSheet.Unprotect clave Application.ScreenUpdating = False Application.EnableEvents = False ' For Each c In Target Range("I2:K2").Copy Cells(c.Row, "I") Next ' c1 = "D" c2 = "F" c3 = "G" u = Range("A" & Rows.Count).End(xlUp).Row With ActiveWorkbook.Worksheets("Hoja1").Sort .SortFields.Clear .SortFields.Add Key:=Range(c1 & "2:" & c1 & u), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range(c2 & "2:" & c2 & u), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range(c3 & "2:" & c3 & u), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A1:K" & u) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' an1 = Cells(2, c1) an2 = Cells(2, c2) an3 = Cells(2, c3) con = 0 For i = 2 To u If an1 = Cells(i, c1) And _ an2 = Cells(i, c2) And _ an3 = Cells(i, c3) Then con = con + 1 Else con = 1 End If Cells(i, "H") = con an1 = Cells(i, c1) an2 = Cells(i, c2) an3 = Cells(i, c3) Next ' With ActiveWorkbook.Worksheets("Hoja1").Sort .SortFields.Clear .SortFields.Add Key:=Range("A2:A" & u), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A1:K" & u) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' 'If Not Intersect(Target, Range("G:G")) Is Nothing Then Range("A" & Target.Row & ":H" & Target.Row).Locked = True 'End If ' ActiveSheet.Protect clave, DrawingObjects:=False, Contents:=True, _ Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _ AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, _ AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _ AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _ AllowUsingPivotTables:=True ' Application.EnableEvents = True End If End Sub
Saludos.Dante Amor
Si es lo que necesitas. No olvides valorar la respuesta.
Algo esta sucediendo, que no se copian las fórmulas de las columnas I, J,K a las filas que se van ingresando...
Y en la columna H no se esta actualizando el consecutivo que debe llevar de acuerdo a la columna D, F, G.
No se esta bloqueando la fila después de introducir el valor en la columna G.
Se me borro una columna en la ultima actualización, la de Status... Es la única que queda desbloqueada...
Te envío de nuevo el archivo...
Prueba con el archivo que yo te envié.
Si agregaste la columna de Status, tengo que cambiar la macro, esa es una columna nueva, en el último archivo que me enviaste no venía esa columna.
Te anexo la macro actualizada con una columna más
Private Sub Worksheet_Change(ByVal Target As Range) 'Por.Dante Amor clave = "abc" ' If Not Intersect(Target, Range("A:G, I:I")) Is Nothing Then ActiveSheet.Unprotect clave Application.ScreenUpdating = False Application.EnableEvents = False ' For Each c In Target Range("J2:L2").Copy Cells(c.Row, "J") Next ' c1 = "D" c2 = "F" c3 = "G" u = Range("A" & Rows.Count).End(xlUp).Row With ActiveWorkbook.Worksheets("Hoja1").Sort .SortFields.Clear .SortFields.Add Key:=Range(c1 & "2:" & c1 & u), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range(c2 & "2:" & c2 & u), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range(c3 & "2:" & c3 & u), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A1:L" & u) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' an1 = Cells(2, c1) an2 = Cells(2, c2) an3 = Cells(2, c3) con = 0 For i = 2 To u If an1 = Cells(i, c1) And _ an2 = Cells(i, c2) And _ an3 = Cells(i, c3) Then con = con + 1 Else con = 1 End If Cells(i, "H") = con an1 = Cells(i, c1) an2 = Cells(i, c2) an3 = Cells(i, c3) Next ' With ActiveWorkbook.Worksheets("Hoja1").Sort .SortFields.Clear .SortFields.Add Key:=Range("A2:A" & u), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A1:L" & u) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' If Not Intersect(Target, Range("I:I")) Is Nothing Then Range("A" & Target.Row & ":I" & Target.Row).Locked = True End If ' ActiveSheet.Protect clave, DrawingObjects:=False, Contents:=True, _ Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _ AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, _ AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _ AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _ AllowUsingPivotTables:=True ' Application.EnableEvents = True End If End Sub
Saludos.Dante Amor
Hola. En el archivo que me envías, al intentar ingresar un dato en la Fila 5, esta bloqueada. Al ingresar en la Fila 6, no se ponen las fórmulas de J,K, L como antes se ponían al introducir el dato en la columna D.
Y la columna H no se esta "autocompletando" con la fórmula del consecutivo...
Disculpa lo de la columna, no se que sucedió, que estábamos armando todo sobre una estructura que no es la deseada... Esta ya es...
Gracias! Saludos
Cambia el formato de todas las celdas, quita el indicador de bloqueado y empieza de nuevo a capturar
Captura las fórmulas en la fila 2
No funciona...
Al hacerlo, se bloquean las filas 3,4,5.
La columna H no se esta "autocompletando" con la fórmula del consecutivo...
No se ponen las fórmulas de J,K, L como antes se ponían al introducir el dato en la columna D.
Te envié otro archivo con las celdas desprotegidas
La fila se protegerá hasta que cambies el estatus.
Sigue igual... no se que esta pasando... pero no funciona...
Y se deben proteger al indicar el inciso... se protege toda la fila, menos el status....
La columna H no se esta "autocompletando" con la fórmula del consecutivo...
No se ponen las fórmulas de J,K, L como antes se ponían al introducir el dato en la columna D.
A mi me funciona muy bien.
¿Cómo estás capturando?
Te envío el V4 dam, para que no haya confusión de estar ocupando otro archivo
En la celda A3 escribe 7-2-2015 enter
En ese momento te pone las fórmulas en J, K, L
En D3 escribe 505
En E3 escribe in3
En F3 Alberca
En G3 2
En ese momento en H3 automáticamente te pone el 2
Cambia el estatus en la I3 a Si Procede
En ese momento se bloquea la fila de A a la I
Tengo Excel Mac, se de lo que me hablas, y están habilitadas...
De hecho cambie la configuración a que me pregunte antes de abrir el archivo, le puse habilitar, pero sigue igual...
Lo abrí en Excel en windows, y si funciona...
¿No se porque en Excel Mac no? ¿Sabes qué puede ser?
Al abrirlo en Windows, esta bien, solo hay un detalle.
La fila se debe de proteger al introducir el valor en la columna G, pues ahorita lo hace al modificar la columna I...
Y una vez bloqueada la fila, la única columna que debe de quedar desbloqueada es la I.
Cerre excel en la mac, lo volvi a abrir, abri el archivo y ya funciona la macro...
Solo te pido si me puedes modificar esto:
La fila se debe de proteger al introducir el valor en la columna G, pues ahorita lo hace al modificar la columna I...
Y una vez bloqueada la fila, la única columna que debe de quedar desbloqueada es la I.
Perdoname tanta lata!
El vba para mac es diferente que el de windows. No tengo mac así que no lo puedo probar y por lo tanto no puedo saber si funciona en mac.
Entra a vba, casi al final de la macro dice esto
If Not Intersect(Target, Range("I:I")) Is Nothing Then
cámbialo por esto
If Not Intersect(Target, Range("G:G")) Is Nothing Then
- Compartir respuesta