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

Respuesta
1

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

Abro el ultimo, y al poner la fecha, no se pone nada.....

¿Estás habilitando las macros?

Cuando abres el archivo te pregunta esto:

O esto:

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

Ya me funciona perfecto en Mac..

Cambie lo que me indicas, y ya bloquea la fila al ingresar el dato en la columna G.

Pero también me esta bloqueando la columna I, y esa quiero que siempre quede DESbloqueada.

¿Me ayudas?

Gracias

Ahí mismo dice esto

Range("A" & Target.Row & ":I" & Target.Row).Locked = True

cambia la I por la G  o por la H

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas