Sumatorias al final de las columnas..

Para DANTE AMOR!

Nuevamente molestándote, tengo una petición, dentro de mi archivo original tengo un formato en especifico en la parte de las sumatorias de algunas columnas, al momento de dar de alta o modificar algún registro por medio de mi form, se tendría que agregar esas operaciones.

Sería el mismo archivo de la pregunta anterior. "PROYECCIONES PROYECTOS."

El formato que deseo obtener esta en la Hoja2, en la parte inferior y este plasmarlo en la hoja1 que es donde se vacían los datos capturados en el formulario.

1 Respuesta

Respuesta
1

Envíame un correo nuevo con el archivo, dentro del archivo me explicas con comentarios y con colores qué necesitas.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Gerardo Mujica Arevalo” y el título de esta pregunta.

Listo Dante, te mande el correo.

Buenas tardes Dante. 

Tuve un problema personal y me ausente unos días. Una gran disculpa.

Prueba con lo siguiente y me comentas

'Alta de un registro
Private Sub CommandButton1_Click()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Integer
Dim Limpiar As String
Dim xControl As Control
'
strTitulo = "PROYECCIONES"
'
If Me.ComboBox1_SUCURSAL = "" Then
    Me.ComboBox1_SUCURSAL.BackColor = &HC0C0FF
    MsgBox "Debe rellenar el campo: SUCURSAL", , strTitulo
    Me.ComboBox1_SUCURSAL.SetFocus
    Exit Sub
        ElseIf Me.txtCliente = "" Then
        Me.txtCliente.BackColor = &HC0C0FF
        MsgBox "Debe rellenar el campo: CLIENTE", , strTitulo
        Me.txtCliente.SetFocus
        Exit Sub
            ElseIf Me.ComboBox2_PMR = "" Then
            Me.ComboBox2_PMR.BackColor = &HC0C0FF
            MsgBox "Debe rellenar el campo: TIPO DE PMR", , strTitulo
            Me.ComboBox2_PMR.SetFocus
            Exit Sub
                ElseIf Me.txtCanal = "" Then
                Me.txtCanal.BackColor = &HC0C0FF
                MsgBox "Debe rellenar el campo: CANAL", , strTitulo
                Me.txtCanal.SetFocus
                Exit Sub
                    ElseIf Me.txtNombrePrograma = "" Then
                    Me.txtNombrePrograma.BackColor = &HC0C0FF
                    MsgBox "Debe rellenar el campo: NOMBRE DEL PROGRAMA", , strTitulo
                    Me.txtNombrePrograma.SetFocus
                    Exit Sub
                        ElseIf Me.txtNombreSAP = "" Then
                        Me.txtNombreSAP.BackColor = &HC0C0FF
                        MsgBox "Debe rellenar el campo: NOMBRE EN SAP", , strTitulo
                        Me.txtNombreSAP.SetFocus
                        Exit Sub
                            ElseIf Me.ComboBox3_GDN = "" Then
                            Me.ComboBox3_GDN.BackColor = &HC0C0FF
                            MsgBox "Debe rellenar el campo: GDN", , strTitulo
                            Me.ComboBox3_GDN.SetFocus
                            Exit Sub
                                ElseIf Me.ComboBox4_ESTATUS = "" Then
                                Me.ComboBox4_ESTATUS.BackColor = &HC0C0FF
                                MsgBox "Debe rellenar el campo: ESTATUS", , strTitulo
                                Me.ComboBox4_ESTATUS.SetFocus
                                Exit Sub
                                    ElseIf Me.ComboBox5_PROB = "" Then
                                    Me.ComboBox5_PROB.BackColor = &HC0C0FF
                                    MsgBox "Debe rellenar el campo: PROBABILIDAD", , strTitulo
                                    Me.ComboBox5_PROB.SetFocus
                                    Exit Sub
                                        ElseIf Me.txtFechaAlta = "" Then
                                        Me.txtFechaAlta.BackColor = &HC0C0FF
                                        MsgBox "Debe rellenar el campo: FECHA DE ALTA EN ARCHIVO", , strTitulo
                                        Me.txtFechaAlta.SetFocus
                                        Exit Sub
                                            ElseIf Me.txtArranque = "" Then
                                            Me.txtArranque.BackColor = &HC0C0FF
                                            MsgBox "Debe rellenar el campo: ARRANQUE", , strTitulo
                                            Me.txtArranque.SetFocus
                                            Exit Sub
                                                ElseIf Me.txtCicloAcumulacion = "" Then
                                                Me.txtCicloAcumulacion.BackColor = &HC0C0FF
                                                MsgBox "Debe rellenar el campo: CICLO DE ACUMULACION DE PUNTOS", , strTitulo
                                                Me.txtCicloAcumulacion.SetFocus
                                                Exit Sub
                                                    ElseIf Me.txtValorContrato = "" Then
                                                    Me.txtValorContrato.BackColor = &HC0C0FF
                                                    MsgBox "Debe rellenar el campo: VALOR DEL CONTRATO", , strTitulo
                                                    Me.txtValorContrato.SetFocus
                                                    Exit Sub
                                                        ElseIf Me.txtProyectado = "" Then
                                                        Me.txtProyectado.BackColor = &HC0C0FF
                                                        MsgBox "Debe rellenar el campo: PROYECTADO", , strTitulo
                                                        Me.txtProyectado.SetFocus
                                                        Exit Sub
                                                            ElseIf Me.txtValorPunto = "" Then
                                                            Me.txtValorPunto.BackColor = &HC0C0FF
                                                            MsgBox "Debe rellenar el campo: VALOR DEL PUNTO", , strTitulo
                                                            Me.txtValorPunto.SetFocus
                                                            Exit Sub
                                                                ElseIf Me.txtPuntosAcumulados = "" Then
                                                                Me.txtPuntosAcumulados.BackColor = &HC0C0FF
                                                                MsgBox "Debe rellenar el campo: PUNTOS ACUMULADOS", , strTitulo
                                                                Me.txtPuntosAcumulados.SetFocus
                                                                Exit Sub
                                                                    ElseIf Me.txtMontoenPesos = "" Then
                                                                    Me.txtMontoenPesos.BackColor = &HC0C0FF
                                                                    MsgBox "Debe rellenar el campo: MONTO EN PESOS", , strTitulo
                                                                    Me.txtMontoenPesos.SetFocus
                                                                    Exit Sub
End If
    'For Each xControl In Me.Controls
    '    If xControl.Tag = "txt" And xControl = Empty Then
    '        xControl.BackColor = &HC0C0FF
    '        MsgBox "Debe rellenar el campo: " & UCase(xControl. ControlTipText), vbInformation, strTitulo
    '        xControl.SetFocus
    '        Exit Sub
    '    End If
    'Next
Continuar = MsgBox("Dar de alta los datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
cuenta = Application.WorksheetFunction.CountIf(Range("A:A"), txtID)
'
If cuenta > 0 Then
    '
    MsgBox "El ID '" & Me.txtID & "' ya se encuentra registrado", vbExclamation, strTitulo
    'Para pasar los datos del formulario a la hoja
    'cuenta = Me.txtID
    'GoTo Continuar
    '
Else
    '
For Each celda In Range("N4:N1000")
If celda.Interior.Color = RGB(153, 0, 153) Then
'celda.Delete Shift:=xlUp
End If
Next celda
For Each celda In Range("O4:O1000")
If celda.Interior.Color = RGB(153, 0, 153) Then
'celda.Delete Shift:=xlDown
End If
Next celda
'
'Encontrar fila vacía al final de la tabla
    i = 2
    Set h1 = Sheets("Hoja1")
    Do While h1.Cells(i, "A") <> ""
        i = i + 1
    Loop
    h1.Rows(i).Insert
    'Set TransRowRng = ThisWorkbook.Worksheets("Hoja1").Cells(4, 1).CurrentRegion
    'NewRow = TransRowRng.Rows.Count + 1
    NewRow = i
    With ThisWorkbook.Worksheets("Hoja1")
        .Cells(NewRow, 1).Value = Me.txtID.Value
        .Cells(NewRow, 2).Value = Me.ComboBox1_SUCURSAL
        .Cells(NewRow, 3).Value = Me.txtCliente
        .Cells(NewRow, 4).Value = Me.ComboBox2_PMR
        .Cells(NewRow, 5).Value = Me.txtCanal
        .Cells(NewRow, 6).Value = Me.txtNombrePrograma
        .Cells(NewRow, 7).Value = Me.txtNombreSAP
        .Cells(NewRow, 8).Value = Me.ComboBox3_GDN
        .Cells(NewRow, 9).Value = Me.ComboBox4_ESTATUS
        .Cells(NewRow, 10).Value = Me.ComboBox5_PROB.Value
        .Cells(NewRow, 11).Value = Me.txtFechaAlta
        .Cells(NewRow, 12).Value = Me.txtArranque
        .Cells(NewRow, 13).Value = Me.txtCicloAcumulacion
        .Cells(NewRow, 14).Value = Me.txtValorContrato.Value
        .Cells(NewRow, 15).Value = Me.txtProyectado.Value
        .Cells(NewRow, 16).Value = Me.txtValorPunto.Value
        .Cells(NewRow, 17).Value = Me.txtPuntosAcumulados.Value
        .Cells(NewRow, 18).Value = Me.txtMontoenPesos.Value
        'PROYECCIONES
        .Cells(NewRow, 19).Value = Me.txtProyEne.Value
        .Cells(NewRow, 20).Value = Me.txtVntEne.Value
        .Cells(NewRow, 21).Value = Me.txtProyFeb.Value
        .Cells(NewRow, 22).Value = Me.txtVntRealFeb.Value
        .Cells(NewRow, 23).Value = Me.txtProyMarzo.Value
        .Cells(NewRow, 24).Value = Me.txtVntRealMarzo.Value
        .Cells(NewRow, 25).Value = Me.txtProyAbril.Value
        .Cells(NewRow, 26).Value = Me.txtVntRealAbril.Value
        .Cells(NewRow, 27).Value = Me.txtProyMayo.Value
        .Cells(NewRow, 28).Value = Me.txtVntRealMayo.Value
        .Cells(NewRow, 29).Value = Me.txtProyJunio.Value
        .Cells(NewRow, 30).Value = Me.txtVntRealJunio.Value
        .Cells(NewRow, 31).Value = Me.txtProyJulio.Value
        .Cells(NewRow, 32).Value = Me.txtVntRealJulio.Value
        .Cells(NewRow, 33).Value = Me.txtProyAgosto.Value
        .Cells(NewRow, 34).Value = Me.txtVntRealAgosto.Value
        .Cells(NewRow, 35).Value = Me.txtProySept.Value
        .Cells(NewRow, 36).Value = Me.txtVntRealSept.Value
        .Cells(NewRow, 37).Value = Me.txtProyOct.Value
        .Cells(NewRow, 38).Value = Me.txtVntRealOct.Value
        .Cells(NewRow, 39).Value = Me.txtProyNov.Value
        .Cells(NewRow, 40).Value = Me.txtVntRealNov.Value
        .Cells(NewRow, 41).Value = Me.txtProyDic.Value
        .Cells(NewRow, 42).Value = Me.txtVntRealDic.Value
'
   End With
   For i = 1 To Range("I" & Rows.Count).End(xlUp).Row
    If Cells(i, "I") = "TERMINADO" Then
        Range(Cells(i, "A"), Cells(i, "AP")).Interior.ColorIndex = 15
    Else
        'Range(Cells(i, "A"), Cells(i, "AP")).Interior.ColorIndex = xlNone
    End If
Next
    MsgBox "Alta exitosa.", vbInformation, strTitulo
   Dim Fila As Long
   Fila = Range("A" & Rows.Count).End(xlUp).Row + 2
   Rows(Fila).Font.Bold = True
   Range("N" & Fila).Formula = "=SUM(N4:N" & Fila - 2 & ")"
   Range("O" & Fila).Formula = "=SUM(O4:O" & Fila - 2 & ")"
   Range("Q" & Fila).Font.Size = 8
   Range("Q" & Fila) = "OTROS PEDIDOS PMR"
   Range("N" & Fila).Interior.Color = RGB(153, 0, 153)
   Range("O" & Fila).Interior.Color = RGB(153, 0, 153)
   Range("N" & Fila).Font.ColorIndex = 2
   Range("O" & Fila).Font.ColorIndex = 2
    '
   'FILA NUEVA
   Dim Fila1, Fila2 As Long
   Fila1 = Range("A" & Rows.Count).End(xlUp).Row + 3
   Fila2 = Range("A" & Rows.Count).End(xlUp).Row + 4
   Rows(Fila1).Font.Bold = True
   Range("Q" & Fila1).Value = "TOTAL"
   Range("Q" & Fila2).Value = "PRESUPUESTO PMR 2017"
    Unload Me
End If
End Sub

No entiendo para que borras la celda con esta instrucción:

celda.Delete Shift:=xlUp

Así que comenté esa celda, porque al borrar de esa forma también desplazas las fórmulas, a lo mejor solamente tienes que limpiar la celda, por ejemplo:

celda.clearcontents

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

La pregunta no admite más respuestas

Más respuestas relacionadas