Registriert seit: 16. Jan 2005
448 Beiträge
|
AW: Wie bekomme ich den EXCEL SPaltenINDEX von einer INteger?
11. Mai 2017, 09:47
Habs schon:
Aufruf: zb für 120 createExcelIndex(120)
Delphi-Quellcode:
(*
n = 26*26 + 26 + 1;
base = 26
numberOfIntegerDigits = Ceiling[Log[base, base - n (1 - base)] - 1];
numberInTuples = n - (base - base^numberOfIntegerDigits)/(1 - base)
charReps =
1 + IntegerDigits[numberInTuples - 1, base, numberOfIntegerDigits];
StringJoin@Part[chR, charReps]
*)
function Dec_To_Base(nBase, nDec_Value, Lead_Zeros: integer; cOmit: string): string;
{Function : converts decimal integer to base n, max = Base36
Parameters : nBase = base number, ie. Hex is base 16
nDec_Value = decimal to be converted
Lead_Zeros = min number of digits if leading zeros required
cOmit = chars to omit from base (eg. I,O,U,etc)
Returns : number in base n as string}
var
Base_PChar: PChar;
Base_String: string;
To_Del, Modulus, DivNo: integer;
temp_string: string;
i, nLen, Len_Base: integer;
begin
{initialise..}
Base_String := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {max = Base36}
To_Del := 0;
Modulus := 0;
DivNo := nDec_Value;
result := '';
if (nBase > 36) then
nBase := 36; {max = Base36}
cOmit := UpperCase(cOmit);
{build string to fit specified base}
if not (cOmit = '') then
begin
{iterate thru' ommited letters}
nLen := Length(cOmit);
for i := 1 to nLen do
begin
To_Del := Pos(cOmit[i], Base_String); {find position of letter}
if (To_Del > 0) then
begin
{remove letter from base string}
Len_Base := Length(Base_String);
temp_string := Copy(Base_String, 0, To_Del - 1);
temp_string := temp_string + Copy(Base_String, To_Del + 1, Len_Base - To_Del);
Base_String := temp_string;
end; {if To_Del>0..}
end; {for i..}
end; {if not cOmit=''..}
{ensure string is required length for base}
SetLength(Base_String, nBase);
Base_PChar := PChar(Base_String);
{divide decimal by base & iterate until zero to convert it}
while DivNo > 0 do
begin
Modulus := DivNo mod nBase; {remainder is next digit}
result := Base_PChar[Modulus] + result;
DivNo := DivNo div nBase;
end; {while..}
{fix zero value}
if (Length(result) = 0) then
result := '0';
{add required leading zeros}
if (Length(result) < Lead_Zeros) then
for i := 1 to (Lead_Zeros - Length(result)) do
result := '0' + result;
end; {function Dec_To_Base}
function Base_To_Dec(nBase: integer; cBase_Value, cOmit: string): integer;
{Function : converts base n integer to decimal, max = Base36
Parameters : nBase = base number, ie. Hex is base 16
cBase_Value = base n integer (as string) to be converted
cOmit = chars to omit from base (eg. I,O,U,etc)
Returns : number in decimal as string}
var
Base_PChar: PChar;
Base_String: string;
To_Del, Unit_Counter: integer;
temp_string: string;
i, nLen, Len_Base: integer;
begin
{initialise..}
Base_String := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {max = Base36}
To_Del := 0;
Unit_Counter := nBase;
result := 0;
if (nBase > 36) then
nBase := 36; {max = Base36}
cOmit := UpperCase(cOmit);
cBase_Value := UpperCase(cBase_Value); {ensure uppercase letters}
{build string to fit specified base}
if not (cOmit = '') then
begin
{iterate thru' ommited letters}
nLen := Length(cOmit);
for i := 1 to nLen do
begin
To_Del := Pos(cOmit[i], Base_String); {find position of letter}
if (To_Del > 0) then
begin
{remove letter from base string}
Len_Base := Length(Base_String);
temp_string := Copy(Base_String, 0, To_Del - 1);
temp_string := temp_string + Copy(Base_String, To_Del + 1, Len_Base - To_Del);
Base_String := temp_string;
end; {if To_Del>0..}
end; {for i..}
end; {if not cOmit=''..}
{ensure string is required length for base}
SetLength(Base_String, nBase);
Base_PChar := PChar(Base_String);
{iterate thru digits of base n value, each digit is a multiple of base n}
nLen := Length(cBase_Value);
if (nLen = 0) then
result := 0 {fix zero value}
else
begin
for i := 1 to nLen do
begin
if (i = 1) then
unit_counter := 1 {1st digit = units}
else if (i > 1) then
unit_counter := unit_counter * nBase; {multiples of base}
result := result
+ ((Pos(Copy(cBase_Value, (Length(cBase_Value) + 1) - i, 1), Base_PChar) - 1)
* unit_counter);
end; {for i:=1..}
end; {else begin..}
end; {function Base_To_Dec}
function GetINtAqui(mystring: string):integer;
var
Base_String: string;
i: Integer;
mychar: char;
begin
Base_String := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {max = Base36}
mychar:=mystring[1];
for i := 0 to length(base_string) do
begin
if mychar = Base_String[i] then
begin
Result:=i-1;
exit;
end;
end;
end;
function makeliststring(mytlist: TStrings; myadd: integer):string;
var
i: Integer;
myliststring: string;
begin
for i := 1 to mytlist.Count-1 do
begin
if myliststring='' then
myliststring:=format('%d',[strtoint(mytlist[i])+myadd])
else
myliststring:=Format('%s, %s',[myliststring,format('%d',[strtoint(mytlist[i])+myadd])]);
end;
Result:='{'+myliststring+'}';
end;
function Tform1.MMaconform(mybasnum: string; myadd: integer): string;
var
numpart: tstringlist;
i: Integer;
begin
numpart:=tstringlist.Create;
for i := 0 to length(mybasnum) do
begin
numpart.Add(format('%d',[getintaqui(mybasnum[i])]));
end;
Result:=makeliststring(numpart,myadd);
numpart.free;
end;
procedure Split(Delimiter: Char; Str: string; ListOfStrings: TStrings) ;
begin
ListOfStrings.Clear;
ListOfStrings.Delimiter := Delimiter;
ListOfStrings.StrictDelimiter := True; // Requires D2006 or newer.
ListOfStrings.DelimitedText := Str;
end;
function Tform1.Excelindex(mymmalist: string):string;
var
myexcelchars: tStringlist;
myexcelindexstr,mmalist: string;
i: Integer;
begin
myexcelchars:=tstringlist.Create;
mmalist:=stringreplace(mymmalist,'{','',[rfreplaceall]);
mmalist:=stringreplace(mmalist,'}','',[rfreplaceall]);
split(',',mmalist,myexcelchars);
myexcelindexstr:='';
for i := 0 to myexcelchars.Count-1 do
begin
if myexcelindexstr='' then
myexcelindexstr:=format('%s',[char(strtoint(myexcelchars[i])+ORD('A')-1)])
else
myexcelindexstr:=Format('%s%s',[myexcelindexstr,char(strtoint(myexcelchars[i])+ORD('A')-1)]);
end;
result:=myexcelindexstr;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
showmessage(createexcelindex(120));
end;
function Tform1.createexcelindex(col: integer):string;
var
n: extended;
base: extended;
numberOfIntegerDigits: extended;
numberInTuples,charReps: extended;
begin
n := 26*26 + 26 + 1;
n:=col;
base := 26;
numberOfIntegerDigits := system.Math.ceil(system.Math.LogN(base, base - n *(1 - base)) - 1);
numberInTuples := n - (base - system.Math.power(base,numberOfIntegerDigits))/(1 - base);
//Dec_To_Base(nBase, nDec_Value, Lead_Zeros: integer; cOmit: string)
//charReps := 1 + Dec_To_Base(base,numberInTuples - 1, numberOfIntegerDigits,'');
//ShowMessage(MMAconform(Dec_to_base(26,120,9,''),1));
//ShowMessage(ExcelINDEX(MMAconform(Dec_To_Base(ceil(base),ceil(numberInTuples) - 1, ceil(numberOfIntegerDigits),''),1)));
Result:= ExcelINDEX(MMAconform(Dec_To_Base(ceil(base),ceil(numberInTuples) - 1, ceil(numberOfIntegerDigits),''),1));
end ;
Geändert von wschrabi (11. Mai 2017 um 10:32 Uhr)
|