Wie bekomme ich den EXCEL SPaltenINDEX von einer INteger?

[wschrabi]

Hallo,
ich habe genau das Problem, das ich mit Mathematica schon gelöst bekommen habe.
https://mathematica.stackexchange.co...l-from-integer
Doch jetzt brauche ich es in Delphi.
Wer kann mir bitte helfen?


Ich habe ein Problem im Nachmachen der Mathematica Funktion IntegerDigits[n,b,len].
es convertiert n in base b wie hier beschrieben:
http://delphi-kb.blogspot.co.at/2009...to-base-n.html

(Siehe unter: https://reference.wolfram.com/langua...gerDigits.html)

Mein Ansatz ist:

Delphi-Quellcode:

(* Lösung von: Jacob Akkerboom siehe link oben

chR = CharacterRange["A", "Z"];

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 Tform1.createexcelindex(col: integer):string;
var
   n: integer;
   base: integer;
   numberOfIntegerDigits,numberInTuples,charReps: integer;

begin
n := 26*26 + 26 + 1;
base := 26;
numberOfIntegerDigits := system.Math.ceil(system.Math.LogN(base, base - n *(1 - base)) - 1);
numberInTuples := n - (base - POwer(base,numberOfIntegerDigits))/(1 - base);
charReps = 1 + IntegerDigits[numberInTuples - 1, base, numberOfIntegerDigits];


end   ;

Wer kann mir bitte einen Rat geben?
DANKE
mfg
Walter

[wschrabi]

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   ;

[hstreicher]

jetzt mal ungetested

Delphi-Quellcode:

Function IntToStringExcel(i: Integer): AnsiString;
Var
   s: AnsiString;
Begin
   If i < 27 Then
   Begin
      s := chr(i + pred(Ord('A')));
   End
   Else
   Begin
      s := chr((pred(i) Div 26) + pred(Ord('A'))) + chr((pred(i) Mod 26) + Ord('A'));
   End;
   InttoStringExcel := s;
End;

[HolgerX]

Hmm..

Zitat von hstreicher:

jetzt mal ungetested

Delphi-Quellcode:

Function IntToStringExcel(i: Integer): AnsiString;
Var
   s: AnsiString;
Begin
   If i < 27 Then
   Begin
      s := chr(i + pred(Ord('A')));
   End
   Else
   Begin
      s := chr((pred(i) Div 26) + pred(Ord('A'))) + chr((pred(i) Mod 26) + Ord('A'));
   End;
   InttoStringExcel := s;
End;

Dass funktioniert nur bis ZZ..
Bei neuen Excels geht es mit AAA weiter

Hab da mal was gebastelt, verwendbar für diverse BaseCodierungen.
Bei Excel musste mit nem OffSet gearbeitet werden.

Delphi-Quellcode:

function IntToBase(AValue: Integer; ABaseStr : string; Offset : integer = 0): string;
var
  BaseCount : integer;
  BasePos : integer;
begin
  Result := '';
  BaseCount := Length(ABaseStr);
  if (AValue > Offset) then begin
    while (AValue > 0) do begin
      AValue := AValue - Offset;
      BasePos := AValue mod BaseCount;
      Result := ABaseStr[BasePos+1] + Result;
      AValue := AValue div BaseCount;
    end;
  end else Result := ABaseStr[1];
end;


Excel (CollIndex > 0)
IntToBase(CollIndex, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ',1)

HEX
IntToBase(IntValue, '0123456789ABCDEF')

Base8
IntToBase(IntValue, '01234567')

[wschrabi]

Wenn das ok ist und klappt ist es viel einfacher als meine MMA Convertierte Lösung.
DANKE

STIMMT PERKEKT! Habs mit meiner ROUTINE verglichen, kommt im Range 1..10000 immer das gleiche raus.
DANKE HERZLICH