create cursor crsbul( no c(4) ,yer c(4),miktar n(8))
insert into crsbul values ("3701","d100",150)
insert into crsbul values ("3701","d200",100)
insert into crsbul values ("3701","d700",100)
insert into crsbul values ("3702","d100",250)
insert into crsbul values ("3702","d300",250)
insert into crsbul values ("3702","d800",250)
insert into crsbul values ("3703","d400",250)
SELECT * FROM crsBul ORDER BY yer INTO CURSOR crsSorted nofilter
CrossTab('crsSorted','crsXTab','no','yer','miktar',.T.)
SELECT crsXTab
browse
return
*CrossTab.prg
Lparameters tcSource,tcTarget,tcRowFields,tcColumnField, tcDataField, tlUseBlanks
Local ix,lcConnect,lcField, lnSelect
Local Array aCols[1]
lnSelect = SELECT()
Select Distinct &tcRowFields, Space(10) As uid ;
FROM (m.tcSource) ;
INTO Cursor __crsUID ;
readwrite
Replace All uid With Sys(2015)
Set Textmerge To Memvar m.lcConnect Noshow
Set Textmerge On
For ix = 1 To Alines(aCols,m.tcRowFields,.T.,',')
\\<<IIF(m.ix > 1,' and ','')>>lft.<<aCols[m.ix]>> == rgt.<<aCols[m.ix]>>
Endfor
Set Textmerge To
Set Textmerge Off
Select lft.*, rgt.uid ;
FROM (m.tcSource) lft ;
INNER Join __crsUID rgt On &lcConnect ;
INTO Cursor __crsTemp ;
nofilter
* Cross tab data
* tcSource,tcTarget,tcRowField,tcColumnField, tcDataField
CreateCrossTab('__crsTemp','__crsXTab','uID',m.tcColumnField, m.tcDataField)
Set Textmerge To Memvar m.lcFields Noshow
Set Textmerge On
For ix = 1 To Alines(aCols,m.tcRowFields,.T.,',')
\\<<IIF(m.ix > 1,',','')>>t1.<<aCols[m.ix]>>
Endfor
Set Textmerge To
Set Textmerge Off
If Used(m.tcTarget)
Use In (m.tcTarget)
Endif
Select Distinct &lcFields,t2.* ;
FROM __crsTemp t1 ;
INNER Join __crsXtab t2 ;
ON t1.uid == t2.uid ;
INTO Cursor (m.tcTarget) ;
readwrite
Alter Table (m.tcTarget) Drop Column uid
Use In '__crsUID'
Use In '__crsXTab'
Use In '__crsTemp'
IF m.tlUseBlanks
SELECT (m.tcTarget)
For ix=occurs(',',m.tcRowFields)+2 To Fcount()
lcField=Field(m.ix)
Blank Fields (m.lcField) For isnull(&lcField)
Endfor
endif
SELECT (m.lnSelect)
Function CreateCrossTab
Lparameters tcSource,tcTarget,tcRowField,tcColumnField, tcDataField
Local ix,lcType,lnLen,lnDec,lcType1,lnLen1,lnDec1,lcLeft,lcRight
Local Array aStruct[1],aCols[1], aXTab[1]
For ix=1 To Afields(aStruct,m.tcSource)
If Upper(Trim(m.tcRowField)) == Upper(Trim(aStruct[m.ix,1]))
lcType1 = aStruct[m.ix,2]
lnLen1 = aStruct[m.ix,3]
lnDec1 = aStruct[m.ix,4]
Endif
If Upper(Trim(m.tcDataField)) == Upper(Trim(aStruct[m.ix,1]))
lcType = aStruct[m.ix,2]
lnLen = aStruct[m.ix,3]
lnDec = aStruct[m.ix,4]
Endif
Endfor
Select &tcColumnField,Sys(2015) As orderby ;
FROM (m.tcSource) ;
INTO Cursor __xorder__ ;
nofilter
lcLeft = 't1.'+m.tcColumnField
lcRight = 't2.'+m.tcColumnField
Select t1.orderby,&tcColumnField ;
FROM __xorder__ t1 ;
WHERE t1.orderby == ;
(Select Min(orderby) From __xorder__ t2 ;
WHERE &lcLeft == &lcRight ) ;
ORDER By 1 ;
INTO Cursor __sortCols__
Select &tcColumnField ;
FROM __sortCols__ ;
INTO Array aCols
Use In '__xorder__'
Use In '__sortCols__'
Dimension aXTab[Alen(aCols)+1,5]
aXTab[1,1] = m.tcRowField
aXTab[1,2] = m.lcType1
aXTab[1,3] = m.lnLen1
aXTab[1,4] = m.lnDec1
aXTab[1,5] = .F.
For ix=1 To Alen(aCols)
aXTab[m.ix+1,1] = Chrtran(Trim(aCols[m.ix]),' ','_')
aXTab[m.ix+1,2] = m.lcType
aXTab[m.ix+1,3] = m.lnLen
aXTab[m.ix+1,4] = m.lnDec
aXTab[m.ix+1,5] = .T.
Endfor
Create Cursor (m.tcTarget) From Array aXTab
Local Array arrRec[Floor(65000/Fcount()),Fcount()]
arrRec = .Null.
Select Distinct &tcRowField As _RowData ;
from (m.tcSource) ;
into Cursor _DRows
lnRec = 0
Scan
If m.lnRec = 65000
Insert Into (m.tcTarget) From Array arrRec
arrRec = .F.
lnRec = 0
Endif
lnRec = m.lnRec + 1
arrRec[m.lnRec,1] = _DRows._RowData
Select (m.tcSource)
Scan For Evaluate(m.tcRowField) = arrRec[m.lnRec,1]
arrRec[m.lnRec, ;
Asubscript(aXTab, ;
Ascan(aXTab,;
Chrtran(Trim(;
Evaluate(m.tcSource+'.'+m.tcColumnField)),' ','_')),1)] = ;
Evaluate(m.tcSource+'.'+m.tcDataField)
Endscan
Select (m.tcSource)
Endscan
Use In '_DRows'
Dimension arrRec[m.lnRec,Alen(arrRec,2)]
Insert Into (m.tcTarget) From Array arrRec
Select (m.tcTarget)
Locate
Endfunc
