bb.donnay-software.com

Posted: **Sun Jan 20, 2013 1:46 pm**

The program sticks together lines of two xls or xlsx-files with names: Input1 and Input2, as a result turns out the Output.DBF file which is read out by any Excel version. In the output file every line consists of a line of the 1st file and continuation - a line of the 2nd file if in it there is a line with the same value of the 1st field as in a line of the 1st file.

Headings of columns of initial files and converting of the output file in Excel yet I didn't make. Gives out a mistake when converting. Maybe prompt in what business, what I do not so? Thus Roger's test example works perfectly.

Code: Select all

**********************************************************************
******** (с) Луценко Е.В., 22.01.2013, Краснодар, Россия
******** Склеивание двух XLS-файлов по первому полю:
******** для каждой записи 2-го файла ищется запись с тем же значением
******** 1-го поля в INP1 и запись из INP2 добавляется к записи в INP1
******** выходной файл записывается с именем OUT.XLS
******** Параметров не требуется, если нет исходных файлов - выдаются
******** сообщения, отображается стадия прогноз времени исполнения
**********************************************************************

#INCLUDE "inkey.ch"
#INCLUDE "dcdir.ch"
#INCLUDE "appevent.ch"
#INCLUDE "xbp.ch"
#INCLUDE "dcprint.ch"
#INCLUDE "dcmsg.ch"
#INCLUDE "dll.ch"
#include "dccursor.ch"
#Include "thread.ch"
#INCLUDE "class.CH"
#INCLUDE "dmlb.CH"
#INCLUDE "fileio.CH"
#INCLUDE "dctree.CH"
#INCLUDE "dcicon.CH"
#INCLUDE "dcdialog.CH"
#INCLUDE "outlook.CH"

#pragma Library("ascom10.lib")
#pragma library( "dclip1.lib" )
#pragma library( "dclip2.lib" )
#pragma library( "dclipx.lib" )
#pragma library( "xbtbase1.lib" )
#pragma library( "xbtbase2.lib" )
#pragma library( "xppui2.lib" )

* ---------------
PROCEDURE AppSys
// Рабочий стол остается окном приложения
RETURN
* -------------

FUNCTION Main()

DC_IconDefault(1000)

CLOSE ALL

f1 = 1
IF File("Input1.xls")
   PUBLIC cExcelFile1 := "Input1.xls"
ELSE
   f1 = 0
   mMess = "The file Input1.xls isn't found"
ENDIF
f2 = 1
IF File("Input1.xlsX")
   PUBLIC cExcelFile1 := "Input1.xlsx"
ELSE
   f2 = 0
   mMess = "The file Input1.xlsx isn't found"
ENDIF
IF f1 + f2 = 0
   DC_WinAlert( mMess )
   RETURN nil
ENDIF

f1 = 1
IF File("Input2.xls")
   PUBLIC cExcelFile2 := "Input2.xls"
ELSE
   f1 = 0
   mMess = "The file Input2.xls isn't found"
ENDIF
f2 = 1
IF File("Input2.xlsX")
   PUBLIC cExcelFile2 := "Input2.xlsx"
ELSE
   f2 = 0
   mMess = "The file Input2.xlsx isn't found"
ENDIF
IF f1 + f2 = 0
   DC_WinAlert( mMess )
   RETURN nil
ENDIF

PUBLIC cExcelFile3 := "Output.xls"

PUBLIC mDbaseName1 := "Input1"
PUBLIC mDbaseName2 := "Input2"
PUBLIC mDbaseName3 := "Output"

PUBLIC cDbaseFile1 := "Input1.dbf"
PUBLIC cDbaseFile2 := "Input2.dbf"
PUBLIC cDbaseFile3 := "Output.dbf"

*cExcelFile1 = DC_CurPath() + '\' + cExcelFile1
*cExcelFile2 = DC_CurPath() + '\' + cExcelFile2

// Конвертация XLS-файлов в DBF
LC_Excel2WorkArea( cExcelFile1 )
LC_Excel2WorkArea( cExcelFile2 )

// Создание объединенной базы данных

aStructure1 = DC_ARestore(mDbaseName1+'st.arx')
aStructure2 = DC_ARestore(mDbaseName2+'st.arx')

aStructure3 := aStructure1
FOR j=1 TO LEN(aStructure2)
    AADD(aStructure3, { aStructure2[j,1], aStructure2[j,2], aStructure2[j,3], aStructure2[j,4] } )
NEXT
DbCreate( mDbaseName3 , aStructure3 )         // Создание БД

CLOSE ALL
USE (mDbaseName1) EXCLUSIVE NEW
INDEX ON FIELDGET(1) TO Ind1
INDEX ON FIELDGET(1) TO Ind1uniq UNIQUE
COUNT TO N_Rec1
IF N_Rec1 <> RECCOUNT()
   DC_WinAlert("Values of a key field (1st) in the Input1 file aren't unique")
ENDIF

CLOSE ALL
USE (mDbaseName2) EXCLUSIVE NEW
INDEX ON FIELDGET(1) TO Ind2
INDEX ON FIELDGET(1) TO Ind2uniq UNIQUE
COUNT TO N_Rec2
IF N_Rec2 <> RECCOUNT()
   DC_WinAlert("Values of a key field (1st) in the Input2 file aren't unique")
ENDIF

CLOSE ALL
USE (mDbaseName1) INDEX Ind1 EXCLUSIVE NEW;N_Rec1=RECCOUNT();N_Col1 = FCOUNT()
USE (mDbaseName2) INDEX Ind2 EXCLUSIVE NEW;N_Rec2=RECCOUNT();N_Col2 = FCOUNT()
USE (mDbaseName3) EXCLUSIVE NEW;ZAP

***** Отображение стадии исполнения в кратком варианте *****************************************
nMax  = N_Rec1
nTime = 0
@ 4,5 DCPROGRESS oProgressm SIZE 70,1.1 MAXCOUNT nMax COLOR GRA_CLR_BLUE PERCENT EVERY 100
mMess = 'Sewing of XLS-files on the 1st field (by prof.E.V.Lutsenko)'
*mMess = STRTRAN(mMess, "#", mExcelName)
*mMess = STRTRAN(mMess, "$", cDbaseFile)
DCREAD GUI TITLE mMess PARENT @oDialogm FIT EXIT
oDialogm:show()
DC_GetProgress(oProgressm,0,nMax)
************************************************************************************************

SELECT(mDbaseName1)
DBGOTOP()
DO WHILE .NOT. EOF()
   ar := {}
   FOR j=1 TO N_Col1
       AADD(ar, FIELDGET(j))
   NEXT
   SELECT(mDbaseName2);SET ORDER TO 1;T=DBSEEK(ar[1])   // Если запись с такми ключом найдена во 2-й БД, 
   IF T                                                 // добавить ее и записать в 3-ю БД
      FOR j=1 TO N_Col2
          AADD(ar, FIELDGET(j))
      NEXT
   ENDIF
   SELECT(mDbaseName3)
   APPEND BLANK
   FOR j=1 TO LEN(ar)
       FIELDPUT(j, ar[j])
   NEXT
   DC_GetProgress(oProgressm, ++nTime, nMax)
   SELECT(mDbaseName1)
   DBSKIP(1)
ENDDO
DC_GetProgress(oProgressm,nMax,nMax)
oDialogm:Destroy()

// Запись объединенной базы данных в виде XLS-файла
// Наименования колонок сделать из исходных файлов

aFields1 = DC_ARestore(mDbaseName1+'fn.arx')      // Загрузка XLS-наиименований колонок 1-й БД
aFields2 = DC_ARestore(mDbaseName2+'fn.arx')      // Загрузка XLS-наиименований колонок 2-й БД

aFields3 = aFields1
FOR j=1 TO LEN(aFields2)
    AADD(aFields3, aFields2[j])
NEXT
*SELECT(mDbaseName3)
*DC_WorkArea2Excel(mDbaseName3,,,,aFields3)

CLOSE ALL

mMess = "XLS-files are sewed on the 1st field: #.xlsx + $.xlsx => &.dbf"
mMess = STRTRAN(mMess, '#', mDbaseName1 )
mMess = STRTRAN(mMess, '$', mDbaseName2 )
mMess = STRTRAN(mMess, '&', mDbaseName3 )
LB_Warning(mMess, 'by prof.E.V.Lutsenko' )
 
RETURN nil

******************************************

FUNCTION LC_Excel2WorkArea( cExcelFile )

LOCAL lStatus := .f., oExcel, cPath, oSheet, oBook, aValues, i, j, ;
      aStru, xValue
LOCAL oProgressm, oDialogm, lOk

#if XPPVER > 1900000
  // Create the "Excel.Application" object
  oExcel := CreateObject("Excel.Application")      // Как определить, какой Excel проинсталлирован на компьютере: 2003 или 2007-2010
  IF Empty( oExcel )
    DC_WinAlert( "Excel is not installed" )
    RETURN .f.
  ENDIF
#else
  DC_WinAlert('This feature is available in Xbase++ 1.9 and later only!')
  RETURN .f.
#endif

oExcel:Visible := .f.

// Load a Workbook from an .XLS file
// Get path from ini file

PUBLIC mExcelName := cExcelFile
PUBLIC mDbaseName := SUBSTR(cExcelFile, 1, AT('.', cExcelFile)-1)
PUBLIC cDbaseFile := SUBSTR(cExcelFile, 1, AT('.', cExcelFile)-1)+".dbf"

cExcelFile = DC_CurPath() + '\' + cExcelFile

IF !File(cExcelFile)
   mMess = "The file # isn't found";mMess = STRTRAN(mMess, '#', mExcelName )
   DC_WinAlert( mMess )
   RETURN lStatus
ENDIF

// Активизация чтения Excel-листа

mMess    := 'File opening: "#"';mMess = STRTRAN(mMess, "#", mExcelName)
oScrn    := DC_WaitOn( mMess )
oBook    := oExcel:Workbooks:Open(cExcelFile)
oSheet   := oBook:activeSheet
*aValues := oBook:workSheets(1):usedRange:value     // Загрузка 1-го листа Excel-книги целиком

// Определение количества строк и столбцов с данными в Excel-дисте без его загрузки в оперативную память

oUsedRange  := oSheet:usedRange
N_Col := oUsedRange:Columns:Count()                 // Количество колонок с данными в xls-файле
N_Rec := oUsedRange:Rows:Count()                    // Количество строк   с данными в xls-файле
DC_Impl(oScrn)

********* Сформировать файл Inp_name.txt            // Наименования классификационных и описательных шкал

// R1C1_A1() возвращает буквенные имена колонок по их номеру
// чтобы сформировать текстовую переменную для обращения к Range()

 mLinkBlock = "A1:"+R1C1_A1(N_Col)+'1'              // Традиционное буквенное обозначение столбцов xls-листа
 aValues := oUsedRange:Range(mLinkBlock):Value      // Загрузка ДВУМЕРНОГО массива из одной строки с именами колонок 1-го листа Excel-книги
 aInp_name = aValues[1]                             // Присвоение массиву имен колонок aInp_name знаачений первой строки массива aValues

// Проверка на то, что в 1-й строке ТЕКСТОВЫЙ тип данных (заголовки колонок), и, если нет, выдать сообщение об этом и выйти
FOR j=1 TO N_Col
    IF VALTYPE(aInp_name[j]) <> 'C'
       DC_WinAlert( 'In the 1-st line of the Excel-file there has to be a text heading' )
*      DC_WinAlert( 'В 1-й строке Excel-файла должен быть текстовый заголовок' )
       oBook:close()
       oBook:destroy()
       // Quit Excel
       oExcel:Quit()
       oExcel:Destroy()
       RETURN lStatus       
    ENDIF
NEXT

CrLf  = CHR(13)+CHR(10)                             // Конец строки (абзаца) (CrLf)
mCol_name = ""
FOR j=1 TO N_Col                                    // 1-ю колонку не включаем в Inp_name.txt, т.к. это инф.об источнике данных, а не шкала
    mNameJ = ALLTRIM(aInp_name[j])
    mNameJ = UPPER(SUBSTR(mNameJ,1,1)) + SUBSTR(mNameJ,2)   // Сделать первые символы заголовков колонок большими, а остальные оставить как есть
    mCol_name = mCol_name + mNameJ + CrLf
NEXT
StrFile(mCol_name, mDbaseName+'fn.txt')                     // Добавить путь на папку Inp_data

aField := {}
FOR j=1 TO N_Col                                    // 1-ю колонку не включаем в Inp_name.txt, т.к. это инф.об источнике данных, а не шкала
    mNameJ = ALLTRIM(aInp_name[j])
    mNameJ = UPPER(SUBSTR(mNameJ,1,1)) + SUBSTR(mNameJ,2)   // Сделать первые символы заголовков колонок большими, а остальные оставить как есть
    AADD(aField, mNameJ)
NEXT
DC_ASave(aField, mDbaseName +"fn.arx")             // Запись наиименований колонок

// Создание пустой dbf-таблицы для записи в нее данных из 1-го листа xls-файла ******************
// Определение структуры для dbf-таблицы по значениям всех строк (тип и формат данных в колонках)
// На основе просмотра ВСЕГО xls-файла сделать массивы описания полей и для создания структуры брать MAX из каждого массива
// В dbf-таблицу переносить данные, начиная со 2-й строки xls-листа
// 1-ю строку с наименованиями полей использовать вместо Inp_name.txt или чтобы автоматически его делать

aStructure := {}                      // Массив структуры dbf-таблицы

PRIVATE aFieldName[N_col]             // Наименования колонок для базы данных Inp_data.dbf
PRIVATE aFieldType[N_Col]             // Тип значений в j-й колонке (если есть хотя бы одно текстовое, то текстовое)
PRIVATE aFieldSize[N_Col]             // Максимальный размер значения в j-й колонке в символах
PRIVATE aFieldInt [N_Col]             // Максимальное количество значащих цифр до    десятичной точки в значениях j-й колонки
PRIVATE aFieldDeci[N_Col]             // Максимальное количество значащих цифр после десятичной точки в значениях j-й колонки
PRIVATE aFlag_neg [N_Col]             // Флаг наличия отрицательных значений в j-й колонке

AFILL(aFieldType, "X" )
AFILL(aFieldSize,  1  )
AFILL(aFieldInt ,  1  )
AFILL(aFieldDeci,  0  )
AFILL(aFlag_neg , .F. )

FOR j=1 TO N_Col
    aFieldName[j] = "N"+ALLTRIM(STR(j, 15))
NEXT

// Сдесь сделать цикл по загружаемым блокам xls-листа по N_BlockRec записей

* N_Rec                                                       // Кол-во записей в исходном xls-файле
* N_Col                                                       // Кол-во колонок в исходном xls-файле
  N_RecBlock = 65535                                          // Кол-во записей в блоке загрузки
  N_Block  = 1 + INT( N_Rec / N_RecBlock )                    // Кол-во полных блоков загрузки
  N_RecBlockEnd = ABS( N_Rec - N_RecBlock * ( N_Block - 1 ) ) // Кол-во записей в споследнем (неполном) блоке загрузки, если он есть (число записей в нем > 0)

***** Отображение стадии исполнения в кратком варианте *****************************************

nMax  = N_Col * N_Rec + N_Rec - 1

nTime = 0

@ 4,5 DCPROGRESS oProgressm SIZE 70,1.1 MAXCOUNT nMax COLOR GRA_CLR_CYAN PERCENT EVERY 100
mMess = 'Converting Excel-file to DBF (by prof.E.V.Lutsenko)'
*mMess = STRTRAN(mMess, "#", mExcelName)
*mMess = STRTRAN(mMess, "$", cDbaseFile)
DCREAD GUI TITLE mMess PARENT @oDialogm FIT EXIT
oDialogm:show()
DC_GetProgress(oProgressm,0,nMax)
************************************************************************************************

FOR j=1 TO N_Col                                              // Цикл по колонкам блока загрузки

    FOR mNumBlock = 1 TO N_Block

        IF mNumBlock = 1
           mRec1 = 2 + (mNumBlock - 1) * N_RecBlock           // Начальная запись блока загрузки (в 1-м блоке наим.колонок здесь не загружать)
        ELSE
           mRec1 = 1 + (mNumBlock - 1) * N_RecBlock           // Начальная запись блока загрузки
        ENDIF

        IF mNumBlock * N_RecBlock <= N_Rec
           mRec2 = mNumBlock * N_RecBlock                     // Конечная  запись блока загрузки
        ELSE
           mRec2 = N_Rec                                      // Конечная  запись блока загрузки = конечной записи xls-листа
        ENDIF

        mLinkBlock = R1C1_A1(j)+ALLTRIM(STR(mRec1,15))+":"+R1C1_A1(j)+ALLTRIM(STR(mRec2,15)) // Код обращения к j-му столбцу блока загрузки для Range()
        aValues := oUsedRange:Range(mLinkBlock):Value         // Загрузка ДВУМЕРНОГО массива из одной строки с именами колонок 1-го листа Excel-книги

        FOR i=1 TO mRec2 - mRec1 + 1                          // Цикл по строкам  блока загрузки (посчитать сколько в нем строк)

            mFieldType = VALTYPE(aValues[i,1])

            DO CASE

               CASE mFieldType = "C"      // **************************************************************************
  
                    aFieldType[j] = "C"   // Тип значений в j-й колонке (если есть хотя бы одно текстовое, то текстовое)
                    aFieldSize[j] = MAX(aFieldSize[j], LEN(ALLTRIM(aValues[i,1])))
                    aFieldDeci[j] = 0

               CASE mFieldType = "N"      // **************************************************************************
 
                    IF aValues[i,1] < 0
                       aFlag_neg[j] = .T.
                    ENDIF

                    IF aFieldType[j] <> 'C'
                       aFieldType[j] =  'N'
                    ENDIF

                    mVal = ALLTRIM(STR(aValues[i,1],22,7))
                    mVal = REMRIGHT(mVal,"0")                                 // Убрать подряд идущие нули справа до 1-й значащей цифры
                    Pos  = AT('.', MVal)

                    aFieldInt [j] = Pos - 1                                   // Определить число значащих цифр ДО запятой без ведущих нулей
                    mFieldDeci = LEN(ALLTRIM(mVal)) - aFieldInt [j] - 1
                    aFieldDeci[j] = MAX(aFieldDeci[j], mFieldDeci)
                    aFieldDeci[j] = IF(aFieldDeci[j] <= 7, aFieldDeci[j], 7)  // Ограничить точность исходных данных 7 десятичными знаками
                    // Если с дробной частью, то плюс символ на точку
                    // Если отрицательное, то символ на знак
                    aFieldSize[j] = MAX(aFieldSize[j], aFieldInt[j] + aFieldDeci[j] + 1 + IF(aFlag_neg[j],1,0))

               CASE mFieldType = "D" .OR. mFieldType = "X"      // ****************************************************

                    aFieldType[j] = "C"
                    aFieldSize[j] =  10
                    aFieldDeci[j] =  0

               OTHERWISE

                    aFieldType[j] = "C"
                    aFieldSize[j] =  10
                    aFieldDeci[j] =  0

            ENDCASE
            aFieldSize[j] = IF(aFieldSize[j]<=255,aFieldSize[j],255)
            DC_GetProgress(oProgressm, ++nTime, nMax)
        NEXT
    NEXT
    AADD(aStructure, { aFieldName[j] , aFieldType[j],  aFieldSize[j], aFieldDeci[j] })  // Добавить строку в структуру dbf-таблицы
NEXT

*DC_DebugQout( { aStructure } )
*MsgBox('Stop')

DbCreate( mDbaseName , aStructure )           // Создание БД

DC_ASave(aStructure , mDbaseName +"st.arx")   // Запись структуры БД с ее именем

***** Цикл переноса данных из xls-листа в dbf-таблицу

CLOSE ALL
USE  (mDbaseName) EXCLUSIVE NEW;ZAP
SELECT (mDbaseName)

FOR mNumBlock = 1 TO N_Block

    IF mNumBlock = 1
       mRec1 = 2 + (mNumBlock - 1) * N_RecBlock           // Начальная запись блока загрузки (в 1-м блоке наим.колонок здесь не загружать)
    ELSE
       mRec1 = 1 + (mNumBlock - 1) * N_RecBlock           // Начальная запись блока загрузки
    ENDIF

    IF mNumBlock * N_RecBlock <= N_Rec
       mRec2 = mNumBlock * N_RecBlock                     // Конечная  запись блока загрузки
    ELSE 
       mRec2 = N_Rec                                      // Конечная  запись блока загрузки = конечной записи xls-листа
    ENDIF
    mLinkBlock = "A"+ALLTRIM(STR(mRec1,15))+":"+R1C1_A1(N_Col)+ALLTRIM(STR(mRec2,15))       // Код обращения к блоку загрузки для Range()
    aValues := oUsedRange:Range(mLinkBlock):Value         // Загрузка ДВУМЕРНОГО массива из одной строки с именами колонок 1-го листа Excel-книги

    FOR i=1 TO mRec2 - mRec1 + 1                          // Цикл по строкам  блока загрузки (посчитать сколько в нем строк)

        DBAPPEND()

        FOR j=1 TO N_Col                                  // Цикл по колонкам блока загрузки

            // Преобразовывать значения с типами числа и даты в текст, если тип поля текст
            DO CASE
               CASE VALTYPE(aValues[i,j]) = 'C' .AND. aFieldType[j] = 'C'
                    FIELDPUT(j, aValues[i,j])                                       // Просто занести
               CASE VALTYPE(aValues[i,j]) = 'N' .AND. aFieldType[j] = 'N'
                    FIELDPUT(j, aValues[i,j])                                       // Просто занести
               CASE VALTYPE(aValues[i,j]) = 'N' .AND. aFieldType[j] = 'C'
                    FIELDPUT(j, STR(aValues[i,j], aFieldSize[j], aFieldDeci[j] ))   // Преобразовать число к текстовому виду
               CASE VALTYPE(aValues[i,j]) = 'D' .AND. aFieldType[j] = 'C'
                    FIELDPUT(j, DTOC(aValues[i,j]))                                 // Преобразовать дату к текстовому виду
            ENDCASE        
        NEXT
        DC_GetProgress(oProgressm, ++nTime, nMax)
    NEXT
NEXT

DC_GetProgress(oProgressm,nMax,nMax)
oDialogm:Destroy()

oBook:close()
oBook:destroy()

// Quit Excel
oExcel:Quit()
oExcel:Destroy()

RETURN lStatus

* ###################### Окончание программы конвертации XLS -> DBF #################

******** Функция преобразования номера колонки в ее буквенное наименование
FUNCTION R1C1_A1(mNumColumn)

aLiterCol := {}

******** Однобуквенные наименования столбцов
FOR j1=1 TO 26
    AADD(aLiterCol, CHR(j1+64))
NEXT
*DC_DebugQout( { aLiterCol } )
******** Двухбуквенные наименования столбцов
FOR j1=1 TO 26
    FOR j2=1 TO 26
        AADD(aLiterCol, CHR(j1+64)+CHR(j2+64))
    NEXT
NEXT
******** Трехбуквенные наименования столбцов
FOR j1=1 TO 26
    FOR j2=1 TO 26
        FOR j3=1 TO 26
            AADD(aLiterCol, CHR(j1+64)+CHR(j2+64)+CHR(j3+64))
        NEXT
    NEXT
NEXT

RETURN(aLiterCol[mNumColumn])

**************************************

*   cEnde := ZAHL2CHR(numColumns)
*   aExcel := oSheet:range( "A1:"+cEnde+LTRIM(STR(numRows)) ):value


FUNCTION ZAHL2CHR(numColumns)
LOCAL nMal
LOCAL cEnde

   IF numColumns > 26
      nMal  := INT(numColumns/26)
      cEnde := CHR(nMal+64)+CHR((numColumns-(nMal*26))+64)
   ELSE
      cEnde := CHR(numColumns+64)
   ENDIF

RETURN cEnde

******** Display a warning message
FUNCTION LB_Warning( message, ctitle )

  LOCAL aMsg := {}
  IF valtype(message) # 'A'
    aadd(aMsg,message)
  ELSE
    aMsg := message
  ENDIF
  DC_Msgbox( ,,aMsg,cTitle)

RETURN NIL

[/size]

Posted: **Wed Jan 23, 2013 11:48 am**

Hi Roger and all!
Please, help! Excel-files transformed to DBF. I united them on a key field, and then I can't back transform to Excel. Thus Roger's test example perfectly works. Please, prompt that I do not so!

bb.donnay-software.com

The program sews lines of two xls-files on the general field

The program sews lines of two xls-files on the general field

Re: The program sews lines of two xls-files on the general f