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
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.
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
.
- Compartir respuesta