You've already forked lazarus-ccr
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:
@ -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
|
||||
|
@ -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,
|
||||
|
@ -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;
|
||||
|
||||
|
||||
|
@ -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);
|
||||
|
@ -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"/>
|
||||
|
@ -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);
|
||||
|
Reference in New Issue
Block a user