Typically the accepted approach is to do the following
Number to Letter
public function numberToLetter(ByVal i as long) as string
Dim s as string: s = cells(1,i).address(false,false)
numberToLetter = left(s,len(s)-1)
end function
Letter to Number
Public Function letterToNumber(ByVal s As String) As Long
letterToNumber = Range(s & 1).Column
End Function
However neither of these are particular optimal, as in each case we are creating an object, and then calling a property accessor on the object. Is there a faster approach?
Summary
The core thing to realise is that the lettering system used in Excel is also known as Base26. NumberToLetter is encoding to Base26 from decimal, and LetterToNumber is decoding from Base26 to decimal.
Base conversion can be done with simple loops and
Function base26Encode(ByVal iDecimal As Long) As String
if iDecimal <= 0 then Call Err.Raise(5, "base26Encode" ,"Argument cannot be less than 0")
if iDecimal >= 16384 then Call Err.Raise(5, "base26Encode" ,"There are only 16384 columns in a spreadsheet, thus this function is limited to this number.")
Dim s As String: s = ""
Do
Dim v As Long
v = (iDecimal - 1) Mod 26 + 1
iDecimal = (iDecimal - v) / 26
s = Chr(v + 64) & s
Loop Until iDecimal = 0
base26Encode = s
End Function
Function base26Decode(ByVal sBase26 As String) As Long
sBase26 = UCase(sBase26)
Dim sum As Long: sum = 0
Dim iRefLen As Long: iRefLen = Len(sBase26)
For i = iRefLen To 1 Step -1
sum = sum + (Asc((Mid(sBase26, i))) - 64) * 26 ^ (iRefLen - i)
Next
base26Decode = sum
End Function
Performance
I tested the performance of these functions against the original functions. To do this I used the stdPerformance class of stdVBA.
The code used for testing is as follows:
Sub testPerf()
Dim cMax As Long: cMax = 16384
With stdPerformance.Measure("Encode Original")
For i = 1 To cMax
Call numberToLetter(i)
Next
End With
With stdPerformance.Measure("Encode Optimal")
For i = 1 To cMax
Call base26Encode(i)
Next
End With
With stdPerformance.Measure("Decode Original")
For i = 1 To cMax
Call letterToNumber(base26Encode(i))
Next
End With
With stdPerformance.Measure("Decode Optimal")
For i = 1 To cMax
Call base26Decode(base26Encode(i))
Next
End With
End Sub
The results for which are as follows:
Encode Original: 78 ms
Encode Optimal: 31 ms
Decode Original: 172 ms
Decode Optimal: 63 ms
As shown this is a slightly faster approach (2-3x faster). I am fairly surprised that object creation and property access performed so well however.
can I fill Excel Cells with with more (custom) colors than the Interior.ColorIndex (56 Colors) provides?
I am using "Interior.ColorIndex" but it provides only 56 different colors.
$FormatSheet1.Range("C1").Interior.ColorIndex = 35
You can use the Color property to set an RGB colour value:
$FormatSheet1.Range("C1").Interior.Color = 8454080
VBA has an RGB() function to convert the component R, G and B into an integer, or you can use:
$r = 192; $g = 255; $b = 128;
$rgb = $r + ($g * 256) + ($b * 256 * 256);
# 8454080 (a sickly yellow-green colour I found)
The code below terminates prematurely and thus never sets the Interior Color. Any idea what I'm doing wrong?
A second problem is that it doesn't seem to be grabbing the background color for argument "c" properly.
It seems to always use white (16777215) for the background color, even when I've set the background color to something else.
Function Darken(c As Range) As Long
chg = 0.8
Dim clr As Long
clr = ActiveSheet.Cells(c.Row, c.Column).Interior.Color '<< ALWAYS GRABS 16777215, REGARDLESS OF ACTUAL BACKGROUND COLOR
cRed = clr Mod 256
cGreen = (clr \ 256) Mod 256
cBlue = clr \ (65336)
ActiveCell.Interior.Color = RGB(Int(cRed * chg), Int(cGreen * chg), _
Int(cBlue * chg)) '<< CODE TERMINATES HERE PREMATURELY. WHY DOESN'T IT LIKE THIS?
Darken = clr
End Function
Hello stackoverflow members,
I have an Excel worksheet where specific cells have a red border and also red font size.
At the moment, I'm looking for a way to replace the red color by another one, e.g. blue.
Since I do not have any VBA knowledge, I'm trying to realize this with AutoHotkey and its COM support.
I've made some progress!
However, even though it works, it doesn't change borders of several cells.
The same for font colors - some get changed, others don't get changed.
That's my code:
F1::
xl := ComObjActive("Excel.Application") ; Connect to Excel
ws := xl.ActiveSheet ; Connect to worksheet
column = 65 ; ASCCI code
Loop, 800
{
r++ ; row 1
if (r = 41) ; If row 41 was reached:
{
r = 1 ; Go back to row 1
column := column + 1 ; Next column
}
c := Chr(column) ; ASCCI to String
cell = %c%%r% ; Cell = e.g. A1, etc.
;if xl.range(cell).Borders(xlEdgeLeft).Color = 0x0000FF ; If border color is red - TYPE CONFLICT!
if xl.range(cell).Borders.Color = 0x0000FF ; If border color is red: - WORKS PARTLY
{
;xl.range(cell).Borders(xlEdgeLeft).Color := 0xFFD700 ; Set blue color - I DOUBT IT WILL WORK!
xl.range(cell).Borders.Color := 0xFFD700 ; Set to blue - WORKS PARTLY
}
if xl.range(cell).Font.Color = 0x0000FF ; If font color is red: - WORKS PARTLY
{
xl.range(cell).Font.Color := 0xFFD700 ; Set to blue - WORKS PARTLY
}
}
return
As you can see, I already tried it with if xl.range(cell).Borders(xlEdgeLeft).Color = 0x0000FF
which doesn't seem to work.
It says, "TYPE CONFLICT".
On this screenshot you can see all the successful color adjustments (blue).
The rest, which is red, was not changed.
Result
Any help will be much appreciated!
Problem is solved.
for xlCell in xl.ActiveSheet.UsedRange.Cells ; Used cells
{
for xlBorder in xlCell.Borders ; Where borders are used
{
if (xlBorder.Color = 0x0000FF) ; Red
{
xlBorder.Color := 0x5FD200 ; Green
}
if (xlCell.Font.Color = 0x0000FF) ; Red
{
xlCell.Font.Color := 0x5FD200 ; Green
}
}
}
for xlShape in xl.ActiveSheet.Shapes ; Used shapes
{
if (xlShape.Line.ForeColor.RGB = 0x0000FF) ; Red
{
xlShape.Line.ForeColor.RGB := 0x5FD200 ; Green
}
}
Thanks anyway.
P.S. For the font color within a text there is no solution.
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 5 years ago.
Improve this question
So, I have two strings that are each a max length of 100.
Dim a as String ''has a max length of 100
Dim b as String ''has a max length of 100
These two strings need to be truncated and combined into a new string.
Dim c as String 'has a max length of 100
I need to be able to truncate each string appropriately so that I can get string c as close to 100. I was going to do a bunch of statements by 25 to truncate each one.
if a.length = 100 and b.length =0 then
return a
else if a.length = 100 andalso b.length <= 25 then
return a.truncate(75) & b
else if a.length = 100 andalso b.length <= 50 then
return a.truncate(50) & b
else if....
and so one to hit all the scenarios...
I feel like there is a better way to do this and a more efficient way so that i may not hit scenarios like a.length = 100 and b.length = 51. I would be truncating more characters then needed.
Any suggestions?? Please critique me as needed.
EDIT, This is vb.Net..not C# (I'm between Projects) Sorry!
The reason i do not want to just add them together and truncate them is because if both strings are 100 in length, it will completely truncate off the second string. If they are both 100 then I would want to truncate string a to 50 in length and string b to 50 in length so when they are combined they are 100 total. In other words I need some text from both strings.
If the total length of the strings is greater than the limit then you could take a fraction of each in proportion to their lengths:
Module Module1
Function CombineWithLengthConstraint(a As String, b As String, totalLength As Integer) As String
' trivial case 1:
If totalLength < 1 Then
Return String.Empty
End If
Dim aLen = Len(a)
Dim bLen = Len(b)
' trivial case 2:
If aLen + bLen <= totalLength Then
Return a & b
End If
' impossible-to-satisfy-equably case:
If totalLength = 1 Then
If aLen > 0 Then
Return a.Substring(0, 1)
ElseIf bLen > 0 Then
Return b.Substring(0, 1)
Else
Return String.Empty
End If
End If
' aportion the lengths of the strings to be taken in the ratio of their lengths:
Dim aFrac = CInt(Math.Round(aLen / (aLen + bLen) * totalLength, MidpointRounding.AwayFromZero))
Dim bFrac = CInt(Math.Round(bLen / (aLen + bLen) * totalLength, MidpointRounding.AwayFromZero))
' ensure there is at least one character from each string...
If aFrac = 0 Then
aFrac = 1
bFrac -= 1
End If
If bFrac = 0 Then
bFrac = 1
aFrac -= 1
End If
Dim aPart = a.Substring(0, aFrac)
Dim bPart = b.Substring(0, bFrac)
Return aPart & bPart
End Function
Sub Main()
Dim a = New String("A"c, 10)
Dim b = New String("b"c, 40)
Dim c = CombineWithLengthConstraint(a, b, 10)
Console.WriteLine(c)
Console.WriteLine(Len(c))
Console.ReadLine()
End Sub
End Module
Outputs:
AAbbbbbbbb
10
As you can see, the first string, which was 1/5 of the total number of characters, ended up contributing 1/5 of the result.
The VB.NET Len function gives 0 if its argument is Nothing.
I tested it as working with all lengths from 0 to 100 of both strings being combined into one string of length 100 just in case I had made a mistake with the rounding or anything.
Of course, you could return, say, the ending part of string b instead of the starting part if that made sense in the particular application.
Although not exactly what you asked for, here's another option...
Public Function WeirdConcatinate(a As String, b As String) As String
Dim totalLen = a.Length + b.Length
If totalLen > 100 Then
Dim aLen = 100 * a.Length \ totalLen
Dim bLen = 100 - aLen
Return a.Remove(aLen) & b.Remove(bLen)
Else
Return a & b
End If
End Function
This will give you a number of characters from each string (approximately) proportional to how long they are compared to each other. If both strings are the same length, you'll get 50 from each. If a.Length = 100 and b.Length = 50, you'll end up with 66 from a and 34 from b.
Truncate them after concatenating them, then:
Dim c = a & b
If c.Length > 100 Then c = c.Remove(100)
If you want to preserve as much as possible of the start of each string:
Dim c = ""
If(a.Length > 50 AndAlso b.Length < 50)
c = a.Remove(100 - b.Length) & b
Else If a.Length > 50 AndAlso b.Length > 50
c= a.Remove(50) & b.Remove(50)
Else
c = a & b
End if
If c.Length > 100 Then c = c.Remove(100)
As with some other answers, the algorithm is open to interpretation. My method takes from each string until 100 total characters are taken or the string runs out of characters.
Private Function concat(a As String, b As String, length As Integer) As String
Dim ca As New System.Text.StringBuilder()
Dim cb As New System.Text.StringBuilder()
For i As Integer = 0 To length - 1
ca.Append(If(i >= a.Length, "", a(i)))
cb.Append(If(i >= b.Length, "", b(i)))
If ca.Length + cb.Length >= length Then Exit For
Next
Return (ca.ToString() & cb.ToString() & New String(" "c, 100)).Substring(0, length)
End Function
Sub Main()
Dim a As String = New String("a"c, 0)
Dim b As String = New String("b"c, 5)
Dim c As String = concat(a, b, 100)
Console.WriteLine($"'{c}'")
End Sub
'bbbbb '
(padded to 100 characters, doesn't render in block quote)
Dim a As String = New String("a"c, 30)
Dim b As String = New String("b"c, 90)
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb'
Dim a As String = New String("a"c, 72)
Dim b As String = New String("b"c, 64)
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb'
(your example in a comment. 72 >> 50, 64 >> 50)