I want a function to calculate numerology.For example if i enter "XYZ" then my output should be 3 .
Here is how it became 3:
X = 24
Y = 25
Z = 26
on adding it becomes 75 which again adds up to 12 (7+5) which again adds up to 3(1+2) . Similarly whatever names i should pass,my output should be a single digit score.
Here you are:
Function Numerology(Str)
Dim sum, i, char
' Convert the string to upper case, so that 'X' = 'x'
Str = UCase(Str)
sum = 0
' For each character, ...
For i = 1 To Len(Str)
' Check if it's a letter and raise an exception otherwise
char = Mid(Str, i , 1)
If char < "A" Or char > "Z" Then Err.Raise 5 ' Invalid procedure call or argument
' Add the letter's index number to the sum
sum = sum + Asc(char) - 64
Next
' Calculate the result using the digital root formula (http://en.wikipedia.org/wiki/Digital_root)
Numerology = 1 + (sum - 1) Mod 9
End Function
In vbscript:
Function numerology(literal)
result = 0
for i = 1 to Len(literal)
'' // for each letter, take its ASCII value and substract 64,
'' so "A" becomes 1 and "Z" becomes 26
result = result + Asc(Mid(literal, i, 1)) - 64
next
'' // while result is bigger than 10, let's sum it's digits
while(result > 10)
partial = 0
for i = 1 to Len(CStr(result))
partial = partial + CInt(Mid(CStr(result), i, 1))
next
result = partial
wend
numerology = result
End Function
I have no idea what this could possible be used for but it was fun to write anyway.
Private Function CalcStupidNumber(ByVal s As String) As Integer
s = s.ToLower
If (s.Length = 1) Then 'End condition
Try
Return Integer.Parse(s)
Catch ex As Exception
Return 0
End Try
End If
'cover to Values
Dim x As Int32
Dim tot As Int32 = 0
For x = 0 To s.Length - 1 Step 1
Dim Val As Integer = ConvertToVal(s(x))
tot += Val
Next
Return CalcStupidNumber(tot.ToString())
End Function
Private Function ConvertToVal(ByVal c As Char) As Integer
If (Char.IsDigit(c)) Then
Return Integer.Parse(c)
End If
Return System.Convert.ToInt32(c) - 96 ' offest of a
End Function
Related
In VB6, I am trying to convert a number to binary but when the number has 10 digits i am always getting an Overflow error.
What is the data type where i can store a trillion number?
This is the code which is working when the number has less that 10 digits.
Public Function DecimalToBinary(DecimalNum As Double) As _
String
Dim tmp As String
Dim n As Double
n = DecimalNum
tmp = Trim(Str(n Mod 2))
n = n \ 2
Do While n <> 0
tmp = Trim(Str(n Mod 2)) & tmp
n = n \ 2
Loop
DecimalToBinary = tmp
End Function
One of the problems you will encounter is that the Mod operator will not work with values larger than a Long (2,147,483,647). You can rewrite a Mod function as described in this answer: VBA equivalent to Excel's mod function:
' Divide the number by 2.
' Get the integer quotient for the next iteration.
' Get the remainder for the binary digit.
' Repeat the steps until the quotient is equal to 0.
Public Function DecimalToBinary(DecimalNum As Double) As String
Dim tmp As String
Dim n As Double
n = DecimalNum
Do While n <> 0
tmp = Remainder(n, 2) & tmp
n = Int(n / 2)
Loop
DecimalToBinary = tmp
End Function
Function Remainder(Dividend As Variant, Divisor As Variant) As Variant
Remainder = Dividend - Divisor * Int(Dividend / Divisor)
End Function
You can also rewrite your function to avoid Mod altogether:
Public Function DecimalToBinary2(DecimalNum As Double) As String
Dim tmp As String
Dim n As Double
Dim iCounter As Integer
Dim iBits As Integer
Dim dblMaxSize As Double
n = DecimalNum
iBits = 1
dblMaxSize = 1
' Get number of bits
Do While dblMaxSize <= n
dblMaxSize = dblMaxSize * 2
iBits = iBits + 1
Loop
' Move back down one bit
dblMaxSize = dblMaxSize / 2
iBits = iBits - 1
' Work back down bit by bit
For iCounter = iBits To 1 Step -1
If n - dblMaxSize >= 0 Then
tmp = tmp & "1"
n = n - dblMaxSize
Else
' This bit is too large
tmp = tmp & "0"
End If
dblMaxSize = dblMaxSize / 2
Next
DecimalToBinary2 = tmp
End Function
This function finds the bit that is larger than your number and works back down, bit by bit, figuring out if the value for each bit can be subtracted from your number. It's a pretty basic approach but it does the job.
For both functions, if you want to have your binary string in groups of 8 bits, you can use a function like this to pad your string:
Public Function ConvertToBytes(p_sBits As String)
Dim iLength As Integer
Dim iBytes As Integer
iLength = Len(p_sBits)
If iLength Mod 8 > 0 Then
iBytes = Int(iLength / 8) + 1
Else
iBytes = Int(iLength / 8)
End If
ConvertToBytes = Right("00000000" & p_sBits, iBytes * 8)
End Function
i got a list coma separated values (a,b,c,d,e,f,g,h,....)
i wish to split them into chunks of 5 like (a,b,c,d,e) (f,g,h,i,j)....
can someone help me with the code in classic asp ?
arr = Split(messto, ",") ' convert to array
totalemails = UBound(arr) ' total number of emails
if totalemails mod 5 = 0 then
totalloops = int(totalemails/5)
else
totalloops = int(totalemails/5) + 1
end if
x = 0
y = 0
b = 0
for x = 0 to totalloops
for counter = (5* x) to ((b+5)-1)
if Trim(arr(counter)) <> "" and isnull(trim(arr(counter))) = false then
response.Write(Trim(arr(counter)))
response.Write(counter & "<br>")
mymssto = mymssto & Trim(arr(counter)) & ","
response.Write(mymssto)
end if
next
You want to use Mod() to do this it's very powerful and underutilised function.
Here is a simple example based on the code in the question;
<%
Dim mumberToGroupBy: numberToGroupBy = 5
Dim index, counter, arr, messto
messto = "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q"
arr = Split(messto, ",") ' convert to array
For counter = 0 To UBound(arr)
'Can't divide by 0 so we need to make sure our counter is 1 based.
index = counter + 1
Call Response.Write(Trim(arr(counter)))
'Do we have any remainder in the current grouping?
If index Mod numberToGroupBy = 0 Then Response.Write("<br>")
Next
%>
Output:
abcde
fghij
klmno
pq
Useful Links
A: Change response to only respond one set of values (details the use of Mod())
I want to take a number and convert it into lowercase a-z letters using VBScript.
For example:
1 converts to a
2 converts to b
27 converts to aa
28 converts to ab
and so on...
In particular I am having trouble converting numbers after 26 when converting to 2 letter cell names. (aa, ab, ac, etc.)
You should have a look at the Chr(n) function.
This would fit your needs from a to z:
wscript.echo Chr(number+96)
To represent multiple letters for numbers, (like excel would do it) you'll have to check your number for ranges and use the Mod operator for modulo.
EDIT:
There is a fast food Copy&Paste example on the web: How to convert Excel column numbers into alphabetical characters
Quoted example from microsoft:
For example: The column number is 30.
The column number is divided by 27: 30 / 27 = 1.1111, rounded down by the Int function to "1".
i = 1
Next Column number - (i * 26) = 30 -(1 * 26) = 30 - 26 = 4.
j = 4
Convert the values to alphabetical characters separately,
i = 1 = "A"
j = 4 = "D"
Combined together, they form the column designator "AD".
And its code:
Function ConvertToLetter(iCol As Integer) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function
Neither of the solutions above work for the full Excel range from A to XFD. The first example only works up to ZZ. The second example has boundry problems explained in the code comments below.
//
Function ColumnNumberToLetter(ColumnNumber As Integer) As String
' convert a column number to the Excel letter representation
Dim Div As Double
Dim iMostSignificant As Integer
Dim iLeastSignificant As Integer
Dim Base As Integer
Base = 26
' Column letters are base 26 starting at A=1 and ending at Z=26
' For base 26 math to work we need to adjust the input value to
' base 26 starting at 0
Div = (ColumnNumber - 1) / Base
iMostSignificant = Int(Div)
' The addition of 1 is needed to restore the 0 to 25 result value to
' align with A to Z
iLeastSignificant = 1 + (Div - iMostSignificant) * Base
' convert number to letter
ColumnNumberToLetter = Chr(64 + iLeastSignificant)
' if the input number is larger than the base then the conversion we
' just did is the least significant letter
' Call the function again with the remaining most significant letters
If ColumnNumber > Base Then
ColumnNumberToLetter = ColumnNumberToLetter(iMostSignificant) & ColumnNumberToLetter
End If
End Function
//
try this
function converts(n)
Dim i, c, m
i = n
c = ""
While i > 26
m = (i mod 26)
c = Chr(m+96) & c
i = (i - m) / 26
Wend
c = Chr(i+96) & c
converts = c
end function
WScript.Echo converts(1000)
This function lets you find similar strings from a range without having to do an exact search.
The formula looks like this: =FuzzyFind(A1,B$1:B$20)
assuming the string you are performing a search for is in A1
and your reference or options table is B1:B20
The code is here:
Function FuzzyFind(lookup_value As String, tbl_array As Range) As String
Dim i As Integer, str As String, Value As String
Dim a As Integer, b As Integer, cell As Variant
For Each cell In tbl_array
str = cell
For i = 1 To Len(lookup_value)
If InStr(cell, Mid(lookup_value, i, 1)) > 0 Then
a = a + 1
cell = Mid(cell, 1, InStr(cell, Mid(lookup_value, i, 1)) - 1) & Mid(cell, InStr(cell, Mid(lookup_value, i, 1)) + 1, 9999)
End If
Next i
a = a - Len(cell)
If a > b Then
b = a
Value = str
End If
a = 0
Next cell
FuzzyFind = Value
End Function
The results from this function are hit and miss. Can anyone improve the intelligence of this algorithm?
Thank you :)
I'm not sure exactly what "FuzzyFind" entails, but this is a VLOOKUP that uses the Levenshtein distance to find similar data.
The Levenshtein distance lets you select a "percentage match" that you can specify instead of the typical TRUE or FALSE from a normal VLOOKUP:
Usage is: DTVLookup(A1,$C$1:$C$100,1,90) where 90 is the Levenshtein Distance.
DTVLookup(Value To Find, Range to Search, Column to Return, [Percentage Match])
I typically use this when comparing names that come from different databases like:
Correct Name Example Lookup Percentage Match Other Report
John S Smith John Smith 83 John Smith
Barb Jones Barbara Jones 77 Barbara Jones
Jeffrey Bridge Jeff Bridge 79 Jeff Bridge
Joseph Park Joseph P. Park 79 Joseph P. Park
Jefrey Jones jefre jon 75 jefre jon
Peter Bridge peter f. bridge 80 peter f. bridge
Here's the code:
Function DTVLookup(TheValue As Variant, TheRange As Range, TheColumn As Long, Optional PercentageMatch As Double = 100) As Variant
If TheColumn < 1 Then
DTVLookup = CVErr(xlErrValue)
Exit Function
End If
If TheColumn > TheRange.Columns.Count Then
DTVLookup = CVErr(xlErrRef)
Exit Function
End If
Dim c As Range
For Each c In TheRange.Columns(1).Cells
If UCase(TheValue) = UCase(c) Then
DTVLookup = c.Offset(0, TheColumn - 1)
Exit Function
ElseIf PercentageMatch <> 100 Then
If Levenshtein3(UCase(TheValue), UCase(c)) >= PercentageMatch Then
DTVLookup = c.Offset(0, TheColumn - 1)
Exit Function
End If
End If
Next c
DTVLookup = CVErr(xlErrNA)
End Function
Function Levenshtein3(ByVal string1 As String, ByVal string2 As String) As Long
Dim i As Long, j As Long, string1_length As Long, string2_length As Long
Dim distance(0 To 60, 0 To 50) As Long, smStr1(1 To 60) As Long, smStr2(1 To 50) As Long
Dim min1 As Long, min2 As Long, min3 As Long, minmin As Long, MaxL As Long
string1_length = Len(string1): string2_length = Len(string2)
distance(0, 0) = 0
For i = 1 To string1_length: distance(i, 0) = i: smStr1(i) = Asc(LCase(Mid$(string1, i, 1))): Next
For j = 1 To string2_length: distance(0, j) = j: smStr2(j) = Asc(LCase(Mid$(string2, j, 1))): Next
For i = 1 To string1_length
For j = 1 To string2_length
If smStr1(i) = smStr2(j) Then
distance(i, j) = distance(i - 1, j - 1)
Else
min1 = distance(i - 1, j) + 1
min2 = distance(i, j - 1) + 1
min3 = distance(i - 1, j - 1) + 1
If min2 < min1 Then
If min2 < min3 Then minmin = min2 Else minmin = min3
Else
If min1 < min3 Then minmin = min1 Else minmin = min3
End If
distance(i, j) = minmin
End If
Next
Next
' Levenshtein3 will properly return a percent match (100%=exact) based on similarities and Lengths etc...
MaxL = string1_length: If string2_length > MaxL Then MaxL = string2_length
Levenshtein3 = 100 - CLng((distance(string1_length, string2_length) * 100) / MaxL)
End Function
Try this out, I think it will find the best match
Function FuzzyFind2(lookup_value As String, tbl_array As Range) As String
Dim i As Integer, str As String, Value As String
Dim a As Integer, b As Integer, cell As Variant
Dim Found As Boolean
b = 0
For Each cell In tbl_array
str = cell
i = 1
Found = True
Do While Found = True
Found = False
If InStr(i, str, lookup_value) > 0 Then
a = a + 1
Found = True
i = InStr(i, str, lookup_value) + 1
End If
Loop
If a > b Then
b = a
Value = str
End If
a = 0
Next cell
FuzzyFind2 = Value
End Function
I've been looking for this theme a lot and definitely Holmes IV answer is the best. I would just add a small update to compare always in uppercase. For my problems it recommended me more accurate options.
Function FuzzyFind3(lookup_value As String, tbl_array As Range) As String
Dim i As Integer, str As String, Value As String
Dim a As Integer, b As Integer, cell As Variant
Dim Found As Boolean
b = 0
For Each cell In tbl_array
str = UCase(cell)
i = 1
Found = True
Do While Found = True
Found = False
If InStr(i, str, UCase(lookup_value)) > 0 Then
a = a + 1
Found = True
i = InStr(i, str, UCase(lookup_value)) + 1
End If
Loop
If a > b Then
b = a
Value = str
End If
a = 0
Next cell
FuzzyFind3 = Value
This question already has answers here:
How to convert a column number (e.g. 127) into an Excel column (e.g. AA)
(60 answers)
Closed 9 years ago.
How would you determine the column name (e.g. "AQ" or "BH") of the nth column in Excel?
Edit: A language-agnostic algorithm to determine this is the main goal here.
I once wrote this function to perform that exact task:
public static string Column(int column)
{
column--;
if (column >= 0 && column < 26)
return ((char)('A' + column)).ToString();
else if (column > 25)
return Column(column / 26) + Column(column % 26 + 1);
else
throw new Exception("Invalid Column #" + (column + 1).ToString());
}
Here is the cleanest correct solution I could come up with (in Java, but feel free to use your favorite language):
String getNthColumnName(int n) {
String name = "";
while (n > 0) {
n--;
name = (char)('A' + n%26) + name;
n /= 26;
}
return name;
}
But please do let me know of if you find a mistake in this code, thank you.
A language agnostic algorithm would be as follows:
function getNthColumnName(int n) {
let curPower = 1
while curPower < n {
set curPower = curPower * 26
}
let result = ""
while n > 0 {
let temp = n / curPower
let result = result + char(temp)
set n = n - (curPower * temp)
set curPower = curPower / 26
}
return result
This algorithm also takes into account if Excel gets upgraded again to handle more than 16k columns. If you really wanted to go overboard, you could pass in an additional value and replace the instances of 26 with another number to accomodate alternate alphabets
Thanks, Joseph Sturtevant! Your code works perfectly - I needed it in vbscript, so figured I'd share my version:
Function ColumnLetter(ByVal intColumnNumber)
Dim sResult
intColumnNumber = intColumnNumber - 1
If (intColumnNumber >= 0 And intColumnNumber < 26) Then
sResult = Chr(65 + intColumnNumber)
ElseIf (intColumnNumber >= 26) Then
sResult = ColumnLetter(CLng(intColumnNumber \ 26)) _
& ColumnLetter(CLng(intColumnNumber Mod 26 + 1))
Else
err.Raise 8, "Column()", "Invalid Column #" & CStr(intColumnNumber + 1)
End If
ColumnLetter = sResult
End Function
Joseph's code is good but, if you don't want or need to use a VBA function, try this.
Assuming that the value of n is in cell A2
Use this function:
=MID(ADDRESS(1,A2),2,LEN(ADDRESS(1,A2))-3)
IF(COLUMN()>=26,CHAR(ROUND(COLUMN()/26,1)+64)&CHAR(MOD(COLUMN(),26)+64),CHAR(COLUMN()+64))
This works 2 letter columns (up until column ZZ). You'd have to nest another if statement for 3 letter columns.
The formula above fails on columns AY, AZ and each of the following nY and nZ columns. The corrected formula is:
=IF(COLUMN()>26,CHAR(ROUNDDOWN((COLUMN()-1)/26,0)+64)&CHAR(MOD((COLUMN()-1),26)+65),CHAR(COLUMN()+64)
Ruby one-liner:
def column_name_for(some_int)
some_int.to_s(26).split('').map {|c| (c.to_i(26) + 64).chr }.join # 703 => "AAA"
end
It converts the integer to base26 then splits it and does some math to convert each character from ascii. Finally joins 'em all back together. No division, modulus, or recursion.
Fun.
FROM wcm:
If you don't want to use VBA, you can use this
replace colnr with the number you want
=MID(ADDRESS(1,colnr),2,LEN(ADDRESS(1,colnr))-3)
Please be aware of the fact that this formula is volatile because of the usage of the ADDRESS function. Volatile functions are functions that are recalculated by excel after EVERY change.
Normally excel recalculates formula's only when their dependent references changes.
It could be a performance killer, to use this formula.
And here is a conversion from the VBScript version to SQL Server 2000+.
CREATE FUNCTION [dbo].[GetExcelColRef]
(
#col_seq_no int
)
RETURNS varchar(5)
AS
BEGIN
declare #Result varchar(5)
set #Result = ''
set #col_seq_no = #col_seq_no - 1
If (#col_seq_no >= 0 And #col_seq_no < 26)
BEGIN
set #Result = char(65 + #col_seq_no)
END
ELSE
BEGIN
set #Result = [dbo].[GetExcelColRef] (#col_seq_no / 26) + '' + [dbo].[GetExcelColRef] ((#col_seq_no % 26) + 1)
END
Return #Result
END
GO
This works fine in MS Excel 2003-2010. Should work for previous versions supporting the Cells(...).Address function:
For the 28th column - taking columnNumber=28; Cells(1, columnNumber).Address returns "$AB$1".
Doing a split on the $ sign returns the array: ["","AB","1"]
So Split(Cells(1, columnNumber).Address, "$")(1) gives you the column name "AB".
UPDATE:
Taken from How to convert Excel column numbers into alphabetical characters
' The following VBA function is just one way to convert column number
' values into their equivalent alphabetical characters:
Function ConvertToLetter(iCol As Integer) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function
APPLIES TO: Microsoft Office Excel 2007 SE / 2002 SE / 2000 SE / 97 SE
I suppose you need VBA code:
Public Function GetColumnAddress(nCol As Integer) As String
Dim r As Range
Set r = Range("A1").Columns(nCol)
GetColumnAddress = r.Address
End Function
This does what you want in VBA
Function GetNthExcelColName(n As Integer) As String
Dim s As String
s = Cells(1, n).Address
GetNthExcelColName = Mid(s, 2, InStr(2, s, "$") - 2)
End Function
This seems to work in vb.net
Public Function Column(ByVal pColumn As Integer) As String
pColumn -= 1
If pColumn >= 0 AndAlso pColumn < 26 Then
Return ChrW(Asc("A"c) + pColumn).ToString
ElseIf (pColumn > 25) Then
Return Column(CInt(math.Floor(pColumn / 26))) + Column((pColumn Mod 26) + 1)
Else
stop
Throw New ArgumentException("Invalid column #" + (pColumn + 1).ToString)
End If
End Function
I took Joseph's and tested it to BH, then fed it 980-1000 and it looked good.
In VBA, assuming lCol is the column number:
function ColNum2Letter(lCol as long) as string
ColNum2Letter = Split(Cells(1, lCol).Address, "$")(0)
end function
All these code samples that these good people have posted look fine.
There is one thing to be aware of. Starting with Office 2007, Excel actually has up to 16,384 columns. That translates to XFD (the old max of 256 colums was IV). You will have to modify these methods somewhat to make them work for three characters.
Shouldn't be that hard...
Here's Gary Waters solution
Function ConvertNumberToColumnLetter2(ByVal colNum As Long) As String
Dim i As Long, x As Long
For i = 6 To 0 Step -1
x = (1 - 26 ^ (i + 1)) / (-25) - 1 ‘ Geometric Series formula
If colNum > x Then
ConvertNumberToColumnLetter2 = ConvertNumberToColumnLetter2 & Chr(((colNum - x - 1)\ 26 ^ i) Mod 26 + 65)
End If
Next i
End Function
via http://www.dailydoseofexcel.com/archives/2004/05/21/column-numbers-to-letters/
Considering the comment of wcm (top value = xfd), you can calculate it like this;
function IntToExcel(n: Integer); string;
begin
Result := '';
for i := 2 down to 0 do
begin
if ((n div 26^i)) > 0) or (i = 0) then
Result := Result + Char(Ord('A')+(n div (26^i)) - IIF(i>0;1;0));
n := n mod (26^i);
end;
end;
There are 26 characters in the alphabet and we have a number system just like hex or binary, just with an unusual character set (A..Z), representing positionally the powers of 26: (26^2)(26^1)(26^0).
FYI T-SQL to give the Excel column name given an ordinal (zero-based), as a single statement.
Anything below 0 or above 16,383 (max columns in Excel2010) returns NULL.
; WITH TestData AS ( -- Major change points
SELECT -1 AS FieldOrdinal
UNION ALL
SELECT 0
UNION ALL
SELECT 25
UNION ALL
SELECT 26
UNION ALL
SELECT 701
UNION ALL
SELECT 702
UNION ALL
SELECT 703
UNION ALL
SELECT 16383
UNION ALL
SELECT 16384
)
SELECT
FieldOrdinal
, CASE
WHEN FieldOrdinal < 0 THEN NULL
WHEN FieldOrdinal < 26 THEN ''
WHEN FieldOrdinal < 702 THEN CHAR (65 + FieldOrdinal / 26 - 1)
WHEN FieldOrdinal < 16384 THEN CHAR (65 + FieldOrdinal / 676 - 1)
+ CHAR (65 + (FieldOrdinal / 26) - (FieldOrdinal / 676) * 26 - 1)
ELSE NULL
END
+ CHAR (65 + FieldOrdinal % 26)
FROM TestData
ORDER BY FieldOrdinal
I currently use this, but I have a feeling that it can be optimized.
private String GetNthExcelColName(int n)
{
String firstLetter = "";
//if number is under 26, it has a single letter name
// otherwise, it is 'A' for 27-52, 'B' for 53-78, etc
if(n > 26)
{
//the Converts to double and back to int are just so Floor() can be used
Double value = Convert.ToDouble((n-1) / 26);
int firstLetterVal = Convert.ToInt32(Math.Floor(value))-1;
firstLetter = Convert.ToChar(firstLetterValue + 65).ToString();
}
//second letter repeats
int secondLetterValue = (n-1) % 26;
String secondLetter = Convert.ToChar(secondLetterValue+65).ToString();
return firstLetter + secondLetter;
}
=CHAR(64+COLUMN())