Einzelnen Beitrag anzeigen

wschrabi

Registriert seit: 16. Jan 2005
448 Beiträge
 
#2

AW: Wie bekomme ich den EXCEL SPaltenINDEX von einer INteger?

  Alt 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)
  Mit Zitat antworten Zitat