Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Como hacer para totalizar una columna de un stringgrid por valor (https://www.clubdelphi.com/foros/showthread.php?t=82177)

steelha 05-02-2013 16:36:46

Como hacer para totalizar una columna de un stringgrid por valor
 
Hola foristas, la siguiente duda es acerca de trabajar con los stringgrid, me piden leer un txt el cual trae una inmencidad de datos, lo cual ya realice. Luego me piden que si puedo dar los datos mas resumidos, es decir, que por numero de autorizacion el cual se guarda en la primera columna. Al implementar este codigo el cual y segun yo no iva a tener ningun tipo de problema me encuentro con que me da error de Out of index justamente al entrar en la parte del codigo en rojo he intentado ver el porque y no he dado con el problema. utilizo Delphi 7, tadvstringgrid de los componentes Devexp.

Código Delphi [-]
procedure TForm1.Button4Click(Sender: TObject);
var
  ruta : string;
  dia  : Word;
  mes  : Word;
  ano  : Word;
  hor  : Word;
  min  : Word;
  sec  : Word;
  mil  : Word;
  i    : Integer;
  romp : string;
  total: Real;
  filaactual : integer;
begin
  DecodeDate(Now,ano,mes,Dia);
  DecodeTime(Now,hor,min,sec,mil);
  ruta := OpenDialog1.InitialDir +'Universal_'+inttostr(Dia)+inttostr(mes)+inttostr(ano)+'_'+inttostr(hor)+inttostr(min)+inttostr(sec  )+'.txt';

  i     := 0;
  total := 0;
  filaactual := 0;
  romp  := '';
  romp  := Trim(DataGrid.Cells[0,2]);
  for i := 1 to (DataGrid.RowCount-1) do
  begin
    DataGrid.Row := i; //Posicionar en 1ra fila a trabajar
    If Trim(DataGrid.cells[0,i]) <> '' then
    begin
      If Trim(DataGrid.cells[0,i]) <> Trim(romp) then
          begin
            filaactual := DataGridagrupado.RowCount;
            DataGridagrupado.Row := filaactual;
            DataGridagrupado.Cells[0,filaactual-1] := DataGrid.Cells[0,i];
            DataGridagrupado.Cells[1,filaactual-1] := DataGrid.Cells[1,i];
            DataGridagrupado.Cells[2,filaactual-1] := FloatToStr(total);
            total := 0;
            total := total + StrToFloat(DataGrid.cells[2,i]);
            romp  := Trim(DataGrid.cells[0,i]);
            DataGridagrupado.AddRow;
          end
      else
          total := total + StrToFloat(DataGrid.cells[2,i]);
    end;
  end;

  DataGridagrupado.SaveToCSV(ruta);
end;

duilioisola 05-02-2013 16:58:39

El problema parece estar en que DataGridAgrupado no está inicializado y tiene 0 filas.
Luego FilaActual = 0
En la siguiente linea le dices que guarde en la linea -1 (FilaActual-1) un valor.

Código Delphi [-]
   filaactual := DataGridagrupado.RowCount;
   DataGridagrupado.Row := filaactual;
   DataGridagrupado.Cells[0,filaactual-1] := DataGrid.Cells[0,i];
Quizás deberías mover la línea que inserta una nueva línea al principio.
Código Delphi [-]
  for i := 1 to (DataGrid.RowCount-1) do
  begin
    DataGrid.Row := i; //Posicionar en 1ra fila a trabajar
    If Trim(DataGrid.cells[0,i]) <> '' then
    begin
      If Trim(DataGrid.cells[0,i]) <> Trim(romp) then
          begin
            DataGridagrupado.AddRow;
            filaactual := DataGridagrupado.RowCount;
            DataGridagrupado.Row := filaactual;
            DataGridagrupado.Cells[0,filaactual-1] := DataGrid.Cells[0,i];
            DataGridagrupado.Cells[1,filaactual-1] := DataGrid.Cells[1,i];
            DataGridagrupado.Cells[2,filaactual-1] := FloatToStr(total);

steelha 05-02-2013 17:12:11

Ok gracias probaré, pero por demas ambos stringgrid traen por default 2 filas una para la fixed row (que es el encabezado) y una fila mas sino tedeja el fixed row como si fuera una fila normal

steelha 05-02-2013 17:16:24

Ya lo intente pero aun asi me dice Index out of range

steelha 05-02-2013 18:49:59

Ok problema de index out range resuelto, pero aun me falta mejorar la rotura de total por el valor de la columna 0, Gracias por la ayuda

Código Delphi [-]
procedure TForm1.Button4Click(Sender: TObject);
var
  ruta : string;
  dia  : Word;
  mes  : Word;
  ano  : Word;
  hor  : Word;
  min  : Word;
  sec  : Word;
  mil  : Word;
  i    : Integer;
  romp : string;
  total: Real;
  filaactual : integer;
begin
  DecodeDate(Now,ano,mes,Dia);
  DecodeTime(Now,hor,min,sec,mil);
  ruta := OpenDialog1.InitialDir +'Universal_'+inttostr(Dia)+inttostr(mes)+inttostr(ano)+'_'+inttostr(hor)+inttostr(min)+inttostr(sec  )+'.txt';

  i     := 0;
  total := 0;
  filaactual := 0;
  romp  := '';
  romp  := Trim(DataGrid.Cells[0,2]);
  for i := 1 to (DataGrid.RowCount-1) do
  begin
    DataGrid.Row := i; //Posicionar en 1ra fila a trabajar
    If Trim(DataGrid.cells[0,i]) <> '' then
    begin
      If Trim(DataGrid.cells[0,i]) <> Trim(romp) then
          begin
            filaactual := DataGridagrupado.RowCount;
            DataGridagrupado.Row := filaactual-1;
            DataGridagrupado.Cells[0,filaactual] := DataGrid.Cells[0,i];
            DataGridagrupado.Cells[1,filaactual] := DataGrid.Cells[1,i];
            DataGridagrupado.Cells[2,filaactual] := FloatToStr(total);
            total := 0;
            total := total + StrToFloat(DataGrid.cells[2,i]);
            romp  := Trim(DataGrid.cells[0,i]);
            DataGridagrupado.AddRow;
          end
      else
          total := total + StrToFloat(DataGrid.cells[2,i]);
    end;
  end;

  DataGridagrupado.SaveToCSV(ruta);
end;

steelha 05-02-2013 19:57:05

Bueno el codigo anterior no da ningun error ahora, pero tampoco me coloca nada en el grid solo aparecen una cantidad x de filas en blanco

steelha 07-02-2013 14:11:11

T_T una ayudita con esta parte
 
Ok, todo marcha como quería excepto por un error que no se si tiene solución. Explico: cargo un archivo txt sin separación (no csv, no tab) en un memo (todo bien), luego obtengo los datos que me interesan con Copy(componente, posición,cantidad) perfecto, ya con estos datos los paso a un grid (stringgrid de Devexp tadvsringgrid) :) todo de maravilla, como existen datos repetidos por un valor x debo dar un total para ese registro (wow cuanto me tomo pero listo....ah gracias por la ayuda :P). Acá es donde viene el error cuando estoy creado en la nueva stirnggrid los valores acumulado obtengo un Outmemory y se rompe todo el proceso es decir me quedo:( sin memoria para seguir procesando. No se como solucionar esto si necesitan código completo para analizar y optimizarlo no hay ningun problema es un trabajo que debo tener listo para poder procesar los datos enviados de una aseguradora y no digitar toda esa información la cual es mucha tanto así que excel no carga el archivo completo.

duilioisola 07-02-2013 16:38:19

Agrega este metodo, para crear un log a un fichero que se llame igual que la aplicación, pero con extensión .log
Ten en cuenta que agregará (Append) lineas. Deberás borrarlo cada vez que lo ejecutes.
Código Delphi [-]
procedure TForm1.Log(s: string);
var
  F : TextFile;
  FileName : string;
begin
  FileName := ChangeFileExt(Application.ExeName, '.log');
  AssignFile(F, FileName);
  try
     Append(F);
  except
     try
        Rewrite(F);
     except
        on e: Exception do
           ShowMessage('Error al abir fichero : ' + FileName + #13 + e.Message);
     end;
  end;
  WriteLn(F, FormatDatetime('[yyyy-mm-dd hh:nn:ss.zzz] ', Now) + s);
  CloseFile(F);
end;
Luego agrega llamadas a este metodo

Código Delphi [-]
  Log(Format('Inicio bucle. Lineas: %d', [DataGrid.RowCount]));
  for i := 1 to (DataGrid.RowCount-1) do
  begin
    DataGrid.Row := i; //Posicionar en 1ra fila a trabajar
    Log(Format('Lineas: %d - %s', [i, DataGrid.cells[0,i]]));
    If Trim(DataGrid.cells[0,i]) <> '' then
    begin
      If Trim(DataGrid.cells[0,i]) <> Trim(romp) then
          begin
            filaactual := DataGridagrupado.RowCount;
            DataGridagrupado.Row := filaactual-1;
            DataGridagrupado.Cells[0,filaactual] := DataGrid.Cells[0,i];
            DataGridagrupado.Cells[1,filaactual] := DataGrid.Cells[1,i];
            DataGridagrupado.Cells[2,filaactual] := FloatToStr(total);
            total := 0;
            total := total + StrToFloat(DataGrid.cells[2,i]);
            romp  := Trim(DataGrid.cells[0,i]);
            DataGridagrupado.AddRow;
            Log(Format('   Agrupado. Fila Actual: %d - %s', [filaactual, DataGridagrupado.Cells[0,filaactual]]));
          end
      else
      begin
          total := total + StrToFloat(DataGrid.cells[2,i]);
          Log(Format('   Agrego a Total: %s', [DataGrid.cells[2,i]));
      end;
    end;
  end;
  Log(Format('Fin bucle'));

Supongo que verás que de alguna manera FilaActual se sale de control y toma un valor muy alto, creando esa cantidad de filas.

steelha 07-02-2013 17:33:23

Muchas gracias duilioisola por esas lineas :) ya se como hacer un log file gracias a usted.
Pero la cantidad de lineas inmensas vienen del txt original pero se carga facil en el memo y cuando ejecuto el primer proceso que se encarga de dividir los valores tomar los que necesito y colocar el punto decimal en la posicion correcta no da problema. ahora cuando estoy realizando el segundo paso que seria totalizar esa informacion por numero de autorizacion en cierto punto da el error de outmemory. te pasare el codigo completo incluyendo el archivo si deseas

steelha 07-02-2013 17:43:23

1 Archivos Adjunto(s)
Aca esta el codigo completo

steelha 07-02-2013 17:46:36

No puedo enviar el archivo txt ya que el tamaño excede el maximo permitido

duilioisola 07-02-2013 17:47:51

¿Haz probado a importar solo una pequeña parte del fichero?
Copia 10 o 20 lineas del txt original (o el número que tenga sentido) a un txt de prueba y ves qué pasa con el log.

steelha 07-02-2013 17:52:44

Ya te envie todo, pero si he probado y no me da error sin cancelo el proceso y tengo pocos registros. Lo malo es que es un archivo inmenso y debe trabajarse por completo no lo envían por partes.

duilioisola 07-02-2013 18:37:32

Parece que tienes un problema de capacidad de memoria.

No tengo el componente que utilizas (TAdvStringGrid), pero parece que tiene algunas funcionalidades que el TStringGrid no tiene. En especial la de AddRow.
Esto me hace suponer que también debe tener DelRow o algo para borrar una línea.

Veo que tienes dos StringGrids, pero que solo necesitas uno a la vez.
Lo que puedes probar es llenar uno mientras vacías el otro.
Puedes hacer la siguiente prueba:
Código Delphi [-]
  Log(Format('Inicio bucle'));
  // Siempre miraré la primera linea
  i := 1;
  // Mientras haya una línea de datos
  while (DataGrid.RowCount > 1) do
  begin
    Log(Format('DataGrid.RowCount: %d - DataGridAgrupado.RowCount: %d', [DataGrid.RowCount, DataGridAgrupado.RowCount]));
    // Posicionar en 1ra fila a trabajar
    DataGrid.Row := i;
    If Trim(DataGrid.cells[0,i]) <> '' then
    begin
      If Trim(DataGrid.cells[0,i]) <> Trim(romp) then
          begin
            DataGridagrupado.AddRow;
            filaactual := DataGridagrupado.RowCount-3;
            DataGridagrupado.Row := filaactual;
            DataGridagrupado.Cells[0,filaactual] := autoriz;
            DataGridagrupado.Cells[1,filaactual] := nombre;
            DataGridagrupado.Cells[2,filaactual] := FloatToStr(total);
            DataGridagrupado.Cells[3,filaactual] := fecha;
            total := 0;                                  TStrings
            total := total + StrToFloat(DataGrid.cells[2,i]);
            romp  := Trim(DataGrid.cells[0,i]);
            nombre  := Trim(DataGrid.cells[1,i]);
            autoriz := Trim(DataGrid.cells[0,i]);
            fecha   := Trim(DataGrid.cells[3,i]);
            // Log(Format('   Agrupado. Fila Actual: %d - %s', [filaactual, DataGridagrupado.Cells[0,filaactual]]));
          end
      else
        begin
          total   := total + StrToFloat(DataGrid.cells[2,i]);
          nombre  := Trim(DataGrid.cells[1,i]);
          autoriz := Trim(DataGrid.cells[0,i]);
          fecha   := Trim(DataGrid.cells[3,i]);
          // Log(Format('   Agrego a Total: %s', [DataGrid.cells[2,i]]));
        end;
    end;
    // Aqui trato de borrar la linea en la que estoy (primera linea)
    DataGrid.DelRow;
  end;
  Log(Format('Fin bucle'));

Nota:
No se como estará implementado DataGrid.DelRow. Quizás debas pasarle el nro de línea a borrar. En este caso sería la 1. DataGrid.DelRow(1);

steelha 07-02-2013 18:57:13

Ok voy a implementar las lineas a ver

duilioisola 07-02-2013 19:48:37

He estado jugando un poco con el código y he creado esta función, que creo que hace lo que tu necesitas, pero no lo va pasando de Memo en Memo...
La única interacción que tiene con el formulario es el Label que cuenta las líneas. Si quitas eso y el Application.ProcessMessages será mucho más rápido.

He creado un botón llamado ButtonAgrupar y le he puesto el código.

No utiliza StringGrids, que son visuales, por lo que no utiliza tanta memoria. De todos modos carga el texto en un TStringList.
Es fácilmete modificable para no utilizar nada de memoria, abriendo el archivo origen y escribiendo en el archivo destino mediante Readln(F, s); y Writeln(F, s);

Espero que te sirva.

Código Delphi [-]
procedure TForm1.ButtonAgruparClick(Sender: TObject);
var
   s1, s2 : TStringList;
   archivo: string;
   monto, nombre, autoriz, fecha : string;
   i : Integer;
   cant : Integer;
   conv : Double;
   ruta : string;
   dia  : Word;
   mes  : Word;
   ano  : Word;
   hor  : Word;
   min  : Word;
   sec  : Word;
   mil  : Word;
   romp : string;
   total: Real;
begin
   // inicializo variables
   detener := 'N';
   autoriz :='';
   nombre := '';
   fecha :='';
   total := 0;
   cant := 0;

   // Creo StringLists para trabajar con los textos
   s1 := TStringList.Create;
   s2 := TStringList.Create;
   try
      // Pido datos origen
      OpenDialog1.Execute;
      archivo := OpenDialog1.FileName;

      // Cargar archivo de texto
      s1.LoadFromFile(archivo);

      // Obtengo el nombre del fichero destino
      DecodeDate(Now,ano,mes,Dia);
      DecodeTime(Now,hor,min,sec,mil);
      ruta := OpenDialog1.InitialDir +'Universal_'+inttostr(Dia)+inttostr(mes)+inttostr(ano)+'_'+inttostr(hor)+inttostr(min)+inttostr(sec  )+'.txt';

      // Inicializo romp con el valor de la primera linea
      romp := Trim(Copy(s1[0], 35, 15)); // Rompe por AUTORIZACION

      // Recorro todo el archivo
      for i := 0 to (s1.Count-1) do
      begin
         monto := Trim(Copy(s1[i], 71, 14));   // MONTO
         nombre := Trim(Copy(s1[i], 85, 80));  // NOMBRE
         autoriz := Trim(Copy(s1[i], 35, 15)); // AUTORIZACION
         fecha := Trim(Copy(s1[i], 10,  8));   // FECHA AUTORIZACION

         // Datos completos no error de separacion de lineas
         If (monto <> '') and (nombre <> '') and (autoriz <> '') then
         begin
            // Colocar punto al monto
            conv := (StrToFloat(monto)*0.01);
            monto := FloatToStr(conv);

            // Si la autorizacion no es vacia
            If Trim(autoriz) <> '' then
            begin
               // Si cambio el campo autorizacion, creo un registro e inicializo total
               If Trim(autoriz) <> Trim(romp) then
               begin
                  nombre := fecha + #9 + nombre + #9 + '0000000' + #9 + '0000000' + #9 + '0000000' + #9 + autoriz + #9 + FloatToStr(total) + #9 + FloatToStr(total);
                  s2.Add(nombre);

                  total := 0;
                  romp  := Trim(autoriz);
               end;
            end;

            // Acumulo monto
            total := total + StrToFloat(monto);

            // Cuento lineas tratadas
            cant := cant + 1;
            Label2.Caption := IntToStr(cant);
            Application.ProcessMessages;
         end;

         If Detener = 'S' then Break;
      end;

      // Terminé de recorrer pero todavía tengo un ultimo total
      If (total > 0) then
      begin
         nombre := fecha + #9 + nombre + #9 + '0000000' + #9 + '0000000' + #9 + '0000000' + #9 + autoriz + #9 + FloatToStr(total) + #9 + FloatToStr(total);
         s2.Add(nombre);
      end;

      // Guardo las lineas agrupadas
      s2.SaveToFile(ruta);
   finally
      // Libero StringGrids
      s1.Free;
      s2.Free;
   end;

   // Termino aplicacion
   Application.Terminate;
end;

duilioisola 07-02-2013 20:26:30

Con este procedimiento he logrado procesar los 177000 registros
Solo he tenido que controlar que el valor de monto se pudiera convertir mediante
Código Delphi [-]
            try
               conv := (StrToFloat(monto)*0.01);
               monto := FloatToStr(conv);
            except
               monto := '0';
            end;

También he hecho la prueba de copiar y pegar dos veces el text con 354000 lineas.
También lo pude tratar en una máquina virtual con 384 MB de RAM.

steelha 08-02-2013 00:42:42

Si muchas gracias el codigo funciona de maravillas, con la except que cuando un valor en la linea falta y esta rueda los valores que toma son diferentes. he tratado de controlarlo pero los casos varian a veces son 10 spacios o 5 spacios menos.

steelha 08-02-2013 03:41:17

tambien me añade la ultima fila mal

duilioisola 08-02-2013 11:07:38

Este es el formato de tu fichero:
La línea de en medio es una que tiene una longitud incorrecta porque falta un dato en medio.
Código:

        1        2        3        4        5        6        7        8        9        0
123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789
        F------F                A-------------A                    M------------MN------------------------------------------------------------------------------N
0420000033011201203004457  29      12546964      A010010010100001516000000000366700PORTORREAL GIL RODNER FRANCISCO                                                                    MED001 
0420000033011201203004457  29      12546964      A010010010100001516000000000366700PORTORREAL GIL RODNER FRANCISCO                                                                    MED001 
042000003301120120      12607904      A010010010100001516000000000037500PORTORREAL GIL RODNER FRANCISCO                                                                    S20001 
0420000033011201204000000000      12647953      A010010010100001516000000000038900QUEZADA DE CABRERA ORIA ESTHER                                                                      881201 
0420000033011201204000000000      12647953      A010010010100001516000000000038900QUEZADA DE CABRERA ORIA ESTHER                                                                      881340

Aparentemente todas las líneas tienen la misma longitud.
La primera verificación, antes de procesarla deberá ser comprobar la longitud. Si no es correcta, deberas descartarla y enviar un mensaje o advertencia o lo que sea necesario hacer.

Además de esto, veo que estas desfasado 1 caracter a la izquierda con respecto al campo AUTORIZACION.


La franja horaria es GMT +2. Ahora son las 21:39:12.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi