AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Wie bekomme ich den EXCEL SPaltenINDEX von einer INteger?
Thema durchsuchen
Ansicht
Themen-Optionen

Wie bekomme ich den EXCEL SPaltenINDEX von einer INteger?

Ein Thema von wschrabi · begonnen am 11. Mai 2017 · letzter Beitrag vom 11. Mai 2017
 
wschrabi

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

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

  Alt 11. Mai 2017, 08: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 09:32 Uhr)
  Mit Zitat antworten Zitat
 

 

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 07:56 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz