Foros aprenderaprogramar.com
Didáctica y divulgación de la programación

Buenos días y saludos para tod@s.

Sumar los registros de una columna (Importe) que tengan el mismo valor de otra columna (nombre) y poner el valor de la suma en el último registro de mismo (nombre) en la columna (total). Lo mismo que agrupar por (nombre).

Paso el código.


 da.Fill(dt)
        ds.Tables.Add(dt)

        Dim vmi1 As Integer
        Dim vmt1 As String
        Dim vmt2 As String
        Dim vms1 As Single
        Dim vms2 As Single
        Dim fila As Integer = 0


        While fila <= dt.Rows.Count - 1
            vmt1 = dt.Rows(fila)(1)
            vms1 = 0.0
            vmt2 = ""
            Do While dt.Rows(fila)(1) = vmt1 And fila <= dt.Rows.Count - 1
                vms1 = vms1 + dt.Rows(fila)(2)
                If vmt2 = "" Then
                    vmt2 = dt.Rows(fila)(6)
                Else
                    vmt2 = vmt2 & "," & dt.Rows(fila)(6)
                End If
                dt.Rows(fila)(8) = dt.Rows(fila)(0)

                If fila = dt.Rows.Count - 1 Then
                    dt.Rows(fila)(3) = vms1
                    dt.Rows(fila)(7) = vmt2
                    vms2 = vms2 + vms1
                    Exit While
                Else
                    If fila < dt.Rows.Count - 1 Then
                        fila = fila + 1
                    End If
                End If
            Loop
            If fila < dt.Rows.Count - 1 Then
                fila = fila - 1
                dt.Rows(fila)(3) = vms1
                dt.Rows(fila)(7) = vmt2
                vms2 = vms2 + vms1
                fila = fila + 1
            End If
        End While


dt es un DataTabla.

He estado dándole mil vueltas y no lo conseguía . Ya sé que esta forma es a la antigua usanza... muy rudimentaria pero es de la única manera que lo he logrado.

No sé si habrá alguna forma de hacerlo más práctico y con menos código. Lo he intentado con el Grouping y no me funcionó, viene casi todo con Query y yo uso Acces.

De todas formas ahí queda por si le sirve a alguien.

Gracias y saludos.

Hola a tod@s, buenos días.

Tengo un fichero XML con todas las etiquetas bien esquematizadas.

Mi pregunta es cómo paso valores a las que lo requieren. o qué método es más sencillo para emitir ese fichero.

He leído que se puede hacer por WRITER o por diseño XLS pero la verdad es que no sé como seguir después de ordenar todas las etiquetas.

 Agradecería cualquier tipo de información al respecto.

Saludos.

Hasta hace poco me funcionaba pero no sé que he hecho que ya no funciona y sin el valor de la variable no me deja seguir.

Paso el código por si hay alguna solución.

Public Class FTRANSF_C
    Public vff2 As Date
    Public Const vgf As Date = #1/1/1001#
    Dim strcnn As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                           "Data Source=C:\GESTION\GESTION.mdb"
    Private Sub FTRANSF_C_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        vff2 = FTRANSF.vff
        MsgBox("Fecha seleccionada " & vff2, 1)
        FTRANSF.Close()

        vencimiento(vff1:=vff2)
        'DG1.DataSource = dst.Tables("Vencimientos").DefaultView
        'Dim vpi As Integer
        'vpi = DG1.RowCount
        'If vpi = 0 Then
        ' Dim vpt As String
        'Dim vpt1 As String
        ' Dim vpd As Single
        'Dim vpi1 As Integer = 0
        'For i = 1 To vpi
        'vpt = DG1.Rows(vpi1).Cells(1).Value
        '       While DG1.Rows(vpi1).Cells(1) = vpt
        '      End While
        'Next
        'DG1.Name = "Listado de Vencimientos"
        ' DG1.ReadOnly = True
        'DG1.DataSource = dst.Tables("Vencimientos").DefaultView
        'If DataRow = 0 Then 'DG1.RowCount = 0 Then
        'MsgBox("NO HAY REGISTROS")
        'Else
        'MsgBox("Si")
        'End If
        'End If
    End Sub

    Private Sub vencimiento(ByVal vff1 As Date)
        vff1 = vff2
        If vff1 > vgf Then
            Dim conexion As OleDb.OleDbConnection = _
            New OleDb.OleDbConnection(strcnn)
            Dim adaptador As OleDb.OleDbDataAdapter = _
            New OleDb.OleDbDataAdapter("SELECT TFACTURASR.VENCIMIENTO, " & _
                     "TPROVEEDORES.NOMBRE,TFACTURASR.IMPORTE,TFACTURASR.IMPORTET," & _
                     "TFACTURASR.FACTURANE,TFACTURASR.CONCEPTOP,TFCTURASR.FECHAE," & _
                     "TFACTURASR.FACTURANR,TFACTURASR.FECHAP " & _
                     "FROM TFACTURASR INNER JOIN TPROVEEDORES ON " & _
                     "TPROVEEDORES.CLAVE = TFACTURASR.CPROVEEDOR " & _
                     "WHERE TFACTURASR.VENCIMIENTO = # " & Format(vff1, "MM/DD/YYYY") & " # " & _
                     "AND TFACTURASR.NOPAGAR = 0 AND TFACTURASR.PAGADA = FALSE " & _
                     "AND TPROVEEDORES.NOPAGAR = 0 AND TFACTURASR.FPAGO LIKE '" & 4 & "%'" & _
                     "ORDER BY TFACTURASR.VENCIMIENTO, TPROVEEDORES.NOMBRE", conexion)

            Dim dst As DataSet = New DataSet
            Try
                conexion.Open()
                adaptador.Fill(dst, "Vencimientos")
                DG1.Name = "Listado de Vencimientos"
                'DG1.ReadOnly = True
                DG1.DataSource = dst.Tables("Vencimientos").DefaultView
                If DG1.RowCount = 0 Then
                    MsgBox("NO HAY REGISTROS")
                Else
                    MsgBox("Si")
                End If
                '  Vencimientos = dst.Tables(0)
            Catch ex As OleDb.OleDbException
                MsgBox("se ha producido una excepción: " + ex.Message, 16, Me.Text)
            Finally
                conexion.Close() 'conexion.Dispose()adaptador.Dispose(dst.Dispose())
            End Try
        End If
    End Sub

    Private Sub BS_DoubleClick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BS.Click
        Me.Close()
    End Sub

End Class


Me abre el MENU pero no se para, sigue y finaliza el proceso. ¿Qué puede estar ocurriendo?

Option Explicit On
Option Strict On
Imports System
Imports System.Object
Imports System.Data
Imports System.String
Imports Microsoft
Imports Microsoft.VisualBasic
Module Module1
    Public mfrm As MENU = New MENU()
    Sub Main()
        mfrm.Show()
    End Sub