fpspreadsheet: Calculate the formula SUMIF.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3281 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-07-04 20:41:07 +00:00
parent ad1bf2a46a
commit 4967d9a233
6 changed files with 216 additions and 69 deletions

View File

@ -135,6 +135,7 @@ function fpsPRODUCT (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsSTDEV (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsSTDEVP (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsSUM (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsSUMIF (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsSUMSQ (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsVAR (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsVARP (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
@ -1599,44 +1600,18 @@ var
arg: TsArgument;
cellarg: TsArgument;
criteria: TsArgument;
compare: TFEKind;
compare: TsCompareOperation;
res: Integer;
cell: PCell;
begin
criteria := Args.Pop;
arg := Args.Pop;
compare := fekEqual;
compare := coEqual;
case criteria.ArgumentType of
atCellRange:
criteria := CreateCell(criteria.Worksheet.FindCell(criteria.FirstRow, criteria.FirstCol));
atString:
if Length(criteria.StringValue) > 1 then
case criteria.StringValue[1] of
'<' : case criteria.StringValue[2] of
'>' : begin
compare := fekNotEqual;
Delete(criteria.StringValue, 1, 2);
end;
'=' : begin
compare := fekLessEqual;
Delete(criteria.StringValue, 1, 2);
end;
else compare := fekLess;
Delete(criteria.StringValue, 1, 1);
end;
'>' : case criteria.StringValue[2] of
'=' : begin
compare := fekGreaterEqual;
Delete(criteria.StringValue, 1, 2);
end;
else compare := fekGreater;
Delete(criteria.StringValue, 1, 1);
end;
'=' : begin
compare := fekEqual;
Delete(criteria.StringValue, 1, 1);
end;
end;
criteria.Stringvalue := AnalyzeCompareStr(criteria.StringValue, compare);
end;
n := 0;
for r := arg.FirstRow to arg.LastRow do
@ -1646,18 +1621,18 @@ begin
cellarg := CreateCell(cell);
res := CompareArgs(cellarg, criteria, false);
if res <> MaxInt then begin
if (res < 0) and (compare in [fekLess, fekLessEqual, fekNotEqual])
if (res < 0) and (compare in [coLess, coLessEqual, coNotEqual])
then inc(n)
else
if (res = 0) and (compare in [fekEqual, fekLessEqual, fekGreaterEqual])
if (res = 0) and (compare in [coEqual, coLessEqual, coGreaterEqual])
then inc(n)
else
if (res > 0) and (compare in [fekGreater, fekGreaterEqual, fekNotEqual])
if (res > 0) and (compare in [coGreater, coGreaterEqual, coNotEqual])
then inc(n);
end else
if (compare = fekNotEqual) then inc(n);
if (compare = coNotEqual) then inc(n);
end else
if compare = fekNotEqual then inc(n);
if compare = coNotEqual then inc(n);
end;
Result := CreateNumber(n);
end;
@ -1722,6 +1697,75 @@ begin
Result := CreateNumber(Sum(data))
end;
function fpsSUMIF(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
// SUMIF( range, criteria [, sum_range] )
// - "range" is to the cell range to be analyzed
// - "citeria" can be a cell, a value or a string starting with a symbol like ">" etc.
// (in the former two cases a value is counted if equal to the criteria value)
// - "sum_range" identifies the cells to sum. If omitted, the function uses
// "range" as the "sum_range"
var
cellval, sum: Double;
r, c, rs, cs: Cardinal;
range: TsArgument;
sum_range: TsArgument;
cellarg: TsArgument;
criteria: TsArgument;
compare: TsCompareOperation;
res: Integer;
cell: PCell;
accept: Boolean;
begin
if NumArgs = 3 then begin
sum_range := Args.Pop;
criteria := Args.Pop;
range := Args.Pop;
end else begin
criteria := Args.Pop;
range := Args.Pop;
sum_range := range;
end;
if (range.LastCol - range.FirstCol <> sum_range.LastCol - sum_range.FirstCol) or
(range.LastRow - range.FirstRow <> sum_range.LastRow - sum_range.FirstRow)
then begin
Result := CreateError(errArgError);
exit;
end;
compare := coEqual;
case criteria.ArgumentType of
atCellRange:
criteria := CreateCell(criteria.Worksheet.FindCell(criteria.FirstRow, criteria.FirstCol));
atString:
criteria.Stringvalue := AnalyzeCompareStr(criteria.StringValue, compare);
end;
sum := 0.0;
for r := range.FirstRow to range.LastRow do begin
rs := r - range.FirstRow + sum_range.FirstRow;
for c := range.FirstCol to range.LastCol do begin
cs := c - range.FirstCol + sum_range.FirstCol;
cell := range.Worksheet.FindCell(r, c);
accept := (compare = coNotEqual);
if cell <> nil then begin
cellarg := CreateCell(cell);
res := CompareArgs(cellarg, criteria, false);
if res <> MaxInt then
accept := ( (res < 0) and (compare in [coLess, coLessEqual, coNotEqual]) )
or ( (res = 0) and (compare in [coEqual, coLessEqual, coGreaterEqual]) )
or ( (res > 0) and (compare in [coGreater, coGreaterEqual, coNotEqual]) )
end;
if accept then begin
cell := sum_range.Worksheet.FindCell(rs, cs);
if sum_range.Worksheet.ReadNumericValue(cell, cellval) then
sum := sum + cellval;
end;
end;
end;
Result := CreateNumber(sum);
end;
function fpsSUMSQ(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
// SUMSQ( value1, [value2, ... value_n] )
var

View File

@ -29,10 +29,6 @@ type
// nfdDefault is the dialect used by fpc,
// nfdExcel is the dialect used by Excel
TsCompareOperation = (coNotUsed,
coEqual, coNotEqual, coLess, coGreater, coLessEqual, coGreaterEqual
);
TsNumFormatToken = (nftText, nftThSep, nftDecSep,
nftYear, nftMonth, nftDay, nftHour, nftMinute, nftSecond, nftMilliseconds,
nftAMPM, nftMonthMinute, nftDateTimeSep,

View File

@ -361,6 +361,11 @@ const
);
type
{@@ Identifier for a compare operation }
TsCompareOperation = (coNotUsed,
coEqual, coNotEqual, coLess, coGreater, coLessEqual, coGreaterEqual
);
{@@ State flags while calculating formulas }
TsCalcState = (csNotCalculated, csCalculating, csCalculated);
@ -1210,7 +1215,7 @@ var
(Symbol:'STDEV'; MinParams:1; MaxParams:30; Func:fpsSTDEV), // fekSTDEV
(Symbol:'STDEVP'; MinParams:1; MaxParams:30; Func:fpsSTDEVP), // fekSTDEVP
(Symbol:'SUM'; MinParams:0; MaxParams:30; Func:fpsSUM), // fekSUM
(Symbol:'SUMIF'; MinParams:2; MaxParams:3; Func:nil), // fekSUMIF
(Symbol:'SUMIF'; MinParams:2; MaxParams:3; Func:fpsSUMIF), // fekSUMIF
(Symbol:'SUMSQ'; MinParams:0; MaxParams:30; Func:fpsSUMSQ), // fekSUMSQ
(Symbol:'VAR'; MinParams:1; MaxParams:30; Func:fpsVAR), // fekVAR
(Symbol:'VARP'; MinParams:1; MaxParams:30; Func:fpsVARP), // fekVARP
@ -2211,26 +2216,28 @@ end;
@param ACell Cell to be considered
@param AValue (output) extracted numeric value
@return True if conversion to number is successfull, otherwise false }
@return True if conversion to number is successful, otherwise false }
function TsWorksheet.ReadNumericValue(ACell: PCell; out AValue: Double): Boolean;
begin
Result := True;
case ACell^.ContentType of
cctNumber:
AValue := ACell^.NumberValue;
cctDateTime:
AValue := ACell^.DateTimeValue;
cctBool:
AValue := ord(ACell^.BoolValue);
else
if (ACell^.ContentType <> cctUTF8String) or
not TryStrToFloat(ACell^.UTF8StringValue, AValue) or
not TryStrToDateTime(ACell^.UTF8StringValue, AValue)
then begin
Result := False;
AValue := NaN;
AValue := NaN;
if ACell <> nil then begin
Result := True;
case ACell^.ContentType of
cctNumber:
AValue := ACell^.NumberValue;
cctDateTime:
AValue := ACell^.DateTimeValue;
cctBool:
AValue := ord(ACell^.BoolValue);
else
if (ACell^.ContentType <> cctUTF8String) or
not TryStrToFloat(ACell^.UTF8StringValue, AValue) or
not TryStrToDateTime(ACell^.UTF8StringValue, AValue)
then
Result := False;
end;
end;
end else
Result := False;
end;

View File

@ -128,6 +128,8 @@ function HTMLColorStrToColor(AValue: String): TsColorValue;
function ColorToHTMLColorStr(AValue: TsColorValue): String;
function UTF8TextToXMLText(AText: ansistring): ansistring;
function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String;
procedure Unused(const A1);
procedure Unused(const A1, A2);
procedure Unused(const A1, A2, A3);
@ -1891,6 +1893,45 @@ begin
DateTimeToString(Result, FormatStr, DateTime, FormatSettings,Options);
end;
{@@
Extracts compare information from an input string such as "<2.4".
Is needed for some Excel-strings.
@param AString Input string starting with "<", "<=", ">", ">=", "<>" or "="
If this start is missing a "=" is assumed.
@param ACompareOp Identifier for the comparins operation extracted - see TsCompareOperation
@return Input string with the comparing characters stripped.
}
function AnalyzeComparestr(AString: String; out ACompareOp: TsCompareOperation): String;
procedure RemoveChars(ACount: Integer; ACompare: TsCompareOperation);
begin
ACompareOp := ACompare;
if ACount = 0 then
Result := AString
else
Result := Copy(AString, 1+ACount, Length(AString));
end;
begin
if Length(AString) > 1 then
case AString[1] of
'<' : case AString[2] of
'>' : RemoveChars(2, coNotEqual);
'=' : RemoveChars(2, coLessEqual);
else RemoveChars(1, coLess);
end;
'>' : case AString[2] of
'=' : RemoveChars(2, coGreaterEqual);
else Removechars(1, coGreater);
end;
'=' : RemoveChars(1, coEqual);
else RemoveChars(0, coEqual);
end
else
RemoveChars(0, coEqual);
end;
{$PUSH}{$HINTS OFF}
{@@ Silence warnings due to an unused parameter }
procedure Unused(const A1);

View File

@ -80,6 +80,7 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
@ -88,10 +89,12 @@
<Unit3>
<Filename Value="numberstests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="numberstests"/>
</Unit3>
<Unit4>
<Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="manualtests"/>
</Unit4>
<Unit5>
<Filename Value="testsutility.pas"/>
@ -100,7 +103,6 @@
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>

View File

@ -1324,18 +1324,75 @@
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(Sum([1.0, 1.1, 1.2, 0.9, 0.8]));
// SUMSQ
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=SUMSQ(1, 1.1, 1.2, 0.9, 0.8)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(1.0,
RPNNumber(1.1,
RPNNumber(1.2,
RPNNumber(0.9,
RPNNumber(0.8,
RPNFunc(fekSUMSQ, 5, nil))))))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(SumOfSquares([1.0, 1.1, 1.2, 0.9, 0.8]));
if AFormat <> sfExcel2 then begin
// SUMSQ
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=SUMSQ(1, 1.1, 1.2, 0.9, 0.8)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(1.0,
RPNNumber(1.1,
RPNNumber(1.2,
RPNNumber(0.9,
RPNNumber(0.8,
RPNFunc(fekSUMSQ, 5, nil))))))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(SumOfSquares([1.0, 1.1, 1.2, 0.9, 0.8]));
// SUMIF
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=SUMIF(M1:N3,1)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellRange('M1:N3',
RPNNumber(1, // "1" is in M2
RPNFunc(fekSUMIF, 2, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(1);
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=SUMIF(M1:N3,">=1")');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellRange('M1:N3',
RPNString('>=1', // M2=1, N2=2 --> 2
RPNFunc(fekSUMIF, 2, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(1+2);
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=SUMIF(M1:N3,"<2")');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellRange('M1:N3',
RPNString('<2', // M2=1, N2=2 --> 1
RPNFunc(fekSUMIF, 2, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(1);
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=SUMIF(M1:N3,"<>2")');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellRange('M1:N3',
RPNString('<>2', // N2=2, 6 other cells --> 5
RPNFunc(fekSUMIF, 2, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(1);
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=SUMIF(M1:N3,M1)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellRange('M1:N3',
RPNCellValue('M1', // M1="A", N1="A" -> 2
RPNFunc(fekSUMIF, 2, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(0); // no numbers!
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=SUMIF(M1:N3,M2)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellRange('M1:N3',
RPNCellValue('M2', // M2=1
RPNFunc(fekSUMIF, 2, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(1);
end;
// VAR
inc(Row);