Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.01.01;
Скачать: CL | DM;

Вниз

перенести данные из таблицы excel в другую таблицу excel   Найти похожие ветки 

 
Daria   (2005-12-14 11:28) [0]

Привет всем!!!
мне нужно строки из одной таблицы по определенносму признаку перенести в другую таблицу(сначала создать ее). я пробовала так, но сохраняется только последняя строка. что делать???

unit Unit2;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  DB, StdCtrls, DBCtrls, ADODB,ComObj, OleServer, Excel2000,  Types,  StrUtils,Dialogs;

function FillExcelList(FileName : String; BegRow, EndRow, TestCol : Integer) : String;

implementation

function FillExcelList(FileName : String; BegRow, EndRow, TestCol : Integer) : String;
var ApplicationName,filename0 : String;
   Save_Cursor:TCursor;
   ExcelApplication : Variant;
   RowNo,i,j,n : Integer;
   CellValue : String;
   Errors : String;
   Excel, WorkBook, Sheet: Variant;
begin
Save_Cursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
Result := "";
Errors := "";
ApplicationName := "Excel.Application";
ExcelApplication := Null;
try
 ExcelApplication := CreateOleObject(ApplicationName);
except
 on E : Exception do begin
  Result := "Îøèáêà ïðè ñîçäàíèè ýêçåìïëÿðà Excel : " + E.Message;
  Exit;
 end;
end;
try
 try
  ExcelApplication.Visible := false;
  ExcelApplication.DisplayAlerts := False;
  ExcelApplication.WorkBooks.Open(FileName);
   for RowNo := BegRow to EndRow do begin
   try
       CellValue := Trim(ExcelApplication.WorkBooks[1].WorkSheets[1].Cells[RowNo, TestCol].Value);
    if ((CellValue <> "") and (CellValue <> "0"))
    then begin
     for i := 1 to 11 do begin
      ExcelApplication.WorkBooks[1].WorkSheets[1].Cells[RowNo, i].Interior.Colorindex := 3;
     end;
    end;
    if cellvalue="прамввв" then begin
      n:=3;
      for j:=1 to 11 do begin
      Excel.WorkBooks[1].WorkSheets[1].Cells[n,j].value:= ExcelApplication.WorkBooks[1].WorkSheets[1].Cells[RowNo,j].value;
      end;
      n:=n+1;

   end;

   except
    on E : Exception do begin
     Errors := Errors
     + "&Icirc;&oslash;&egrave;&aacute;&ecirc;&agrave; &iuml;&eth;&egrave; &iuml;&icirc;&euml;&oacute;&divide;&aring;&iacute;&egrave;&egrave; &yuml;&divide;&aring;&eacute;&ecirc;&egrave; ["+IntToStr(RowNo)+", "+IntToStr(TestCol)+"] : "
     + E.Message
     + #13#10;
    end;
   end;
  end;
 except
  on E : Exception do begin
   Errors := Errors
   + "&Icirc;&oslash;&egrave;&aacute;&ecirc;&agrave; &iuml;&eth;&egrave; &iuml;&icirc;&euml;&oacute;&divide;&aring;&iacute;&egrave;&egrave; &auml;&agrave;&iacute;&iacute;&ucirc;&otilde; : "
   + E.Message
   + #13#10;
  end;
 end;
finally
ExcelApplication.Workbooks[1].Save;
 ExcelApplication.Workbooks[1].Close;
 ExcelApplication.Quit;
 ExcelApplication := Unassigned;

 if (Result <> "") then ShowMessage(Result);

 if Length(Errors) > 0 then Result := Errors;
end;
Screen.Cursor := Save_Cursor;
end;
end.


 
umbra ©   (2005-12-14 11:46) [1]

а где эта другая таблица находится?



Страницы: 1 вся ветка

Текущий архив: 2006.01.01;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.026 c
2-1134730235
oleggar
2005-12-16 13:50
2006.01.01
archives


11-1116038421
uli
2005-05-14 06:40
2006.01.01
разрешение экрана


2-1134491294
x.pro
2005-12-13 19:28
2006.01.01
Скорее, вопрос опыта...


9-1122575688
ink
2005-07-28 22:34
2006.01.01
DirectInput8


2-1134576874
Змей
2005-12-14 19:14
2006.01.01
отлавливание sc_minimize