I have two cells with a string of bits 0111010 and 0101011. I want to XOR the two together so that the resulting cell would be 0010001.
I know you can use this for boolean values
=OR(AND(A1,NOT(A2)),AND(A2,NOT(A1)))
but it doesn't work for a string of bits.
You need to use VBA to do this. If you open VBA, create a new Module and enter the function
Public Function BITXOR(x As Long, y As Long)
BITXOR = x Xor y
End Function
You can then use the DEC2BIN and BIN2DEC to convert from binary to decimal to run this function. For example:
Cell A1 = 0111010
Cell A2 = 0101011
=DEC2BIN(BITXOR(BIN2DEC(A1),BIN2DEC(A2)))
You can do this with VBA:
Public Function XOR_binary(b1, b2) As String
Dim len_b1
Dim len_b2
Dim len_diff
Dim i
Dim bit1
Dim bit2
' see if the two string are the same length. If not, add 0's to
' the beginning of the shorter string
len_b1 = Len(b1)
len_b2 = Len(b2)
len_diff = len_b1 - len_b2
Select Case len_diff
Case Is < 0
' b2 is longer
b1 = String(Abs(len_diff), "0") & b1
Case Is = 0
' they're the same length
Case Is > 0
' b1 is longer
b2 = String(len_diff, "0") & b2
End Select
XOR_binary = ""
For i = Len(b2) To 1 Step -1
bit1 = CInt(Mid(b1, i, 1))
bit2 = CInt(Mid(b2, i, 1))
XOR_binary = CInt(bit1 Xor bit2) & XOR_binary
Next i
End Function
Probably not the best implementation, but it works.
Using your example, A3 contains:
=XOR_Binary(A1,A2)
The resulting string will have the same number of bits as the longest string you pass in.
Here is a solution without using VBA:
=TEXT(SUMPRODUCT(MOD(INT(MID(A1,{1,2,3,4,5,6,7},1))+INT(MID(A2,{1,2,3,4,5,6,7},1)),2),{1000000,100000,10000,1000,100,10,1}),"0000000")
This calculates the bitwise XOR using SUMPRODUCT and TEXT to turn it into a string of bits.
Note: this formula requires both input values to have length 7 (as per your own example) and the output will also have length 7. To allow for different input lengths, simply implement the necessary truncation and/or padding.
You can choose to use some shorthand definitions:
define BitPositions as ={1,2,3,4,5,6,7} (7-bit),
define BitStrings as ={1000000,100000,10000,1000,100,10,1} (7-bit),
define BitFormat as ="0000000" (7-bit),
then your formula can be made a bit more legible/shorter/cleaner:
=TEXT(SUMPRODUCT(MOD(INT(MID(A1,BitPositions,1))+INT(MID(A2,BitPositions,1)),2),BitStrings),BitFormat)
This also makes it easier to work with larger strings of bits, e.g.:
define BitPositions as =ROW(INDIRECT("1:32")) (32-bit),
define BitStrings as =10^(32-ROW(INDIRECT("1:32"))) (32-bit),
define BitFormat as =REPT("0",32) (32-bit)
Should you wish to implement NOT/OR/AND/etc. then you can get your inspiration from these formulas for the decimal counterparts; here are some more in-depth explanations for XOR with SUMPRODUCT though it also uses decimal inputs.
=1-(A1<>0)+(A2<>0) for each bit.
You can split it into individual columns for the above formula using this:
=MID(A1|7|1)
=MID(A1|6|1)
=MID(A1|5|1)
=MID(A1|4|1)
=MID(A1|3|1)
=MID(A1|2|1)
=MID(A1|1|1)
...
' this VBA returns a double that has to be formatted on the worksheet.
Option Explicit
Public Function MYXOR(r1 As Range, r2 As Range) As Double
'r1 and r2 are expected as HEX; for example,
'DEC2HEX(CODE("B")) returns ASCII of "B" as HEX
On Error GoTo ErrHandler
MYXOR = "&H" & r1.Value Xor "&H" & r2.Value
GoTo CleanUp
ErrHandler:
MYXOR = Err.Number
Resume CleanUp
CleanUp:
' format the double being returned in MYXOR with TEXT(DEC2HEX(MYXOR(C9,F9)),"00000")
' number of leading zeroes according to the size of the HEX in r1 and r2
End Function
Related
I have trouble comparing 2 double in Excel VBA
suppose that I have the following code
Dim a as double
Dim b as double
a = 0.15
b = 0.01
After a few manipulations on b, b is now equal to 0.6
however the imprecision related to the double data type gives me headache because
if a = b then
//this will never trigger
end if
Do you know how I can remove the trailing imprecision on the double type?
You can't compare floating point values for equality. See this article on "Comparing floating point numbers" for a discussion of how to handle the intrinsic error.
It isn't as simple as comparing to a constant error margin unless you know for sure what the absolute range of the floats is beforehand.
if you are going to do this....
Dim a as double
Dim b as double
a = 0.15
b = 0.01
you need to add the round function in your IF statement like this...
If Round(a,2) = Round(b,2) Then
//code inside block will now trigger.
End If
See also here for additional Microsoft reference.
It is never wise to compare doubles on equality.
Some decimal values map to several floating point representations. So one 0.6 is not always equal to the other 0.6.
If we subtract one from the other, we probably get something like 0.00000000051.
We can now define equality as having a difference smaller that a certain error margin.
Here is a simple function I wrote:
Function dblCheckTheSame(number1 As Double, number2 As Double, Optional Digits As Integer = 12) As Boolean
If (number1 - number2) ^ 2 < (10 ^ -Digits) ^ 2 Then
dblCheckTheSame = True
Else
dblCheckTheSame = False
End If
End Function
Call it with:
MsgBox dblCheckTheSame(1.2345, 1.23456789)
MsgBox dblCheckTheSame(1.2345, 1.23456789, 4)
MsgBox dblCheckTheSame(1.2345678900001, 1.2345678900002)
MsgBox dblCheckTheSame(1.2345678900001, 1.2345678900002, 14)
As has been pointed out, many decimal numbers cannot be represented precisely as traditional floating-point types. Depending on the nature of your problem space, you may be better off using the Decimal VBA type which can represent decimal numbers (base 10) with perfect precision up to a certain decimal point. This is often done for representing money for example where 2-digit decimal precision is often desired.
Dim a as Decimal
Dim b as Decimal
a = 0.15
b = 0.01
Late answer but I'm surprised a solution hasn't been posted that addresses the concerns outlined in the article linked in the (currently) accepted answer, namely that:
Rounding checks equality with absolute tolerance (e.g. 0.0001 units if rounded to 4d.p.) which is rubbish when comparing different values on multiple orders of magnitude (so not just comparing to 0)
Relative tolerance that scales with one of the numbers being compared meanwhile is not mentioned in the current answers, but performs well on non-zero comparisons (however will be bad at comparing to zero as the scaling blows up around then).
To solve this, I've taken inspiration from Python: PEP 485 -- A Function for testing approximate equality to implement the following (in a standard module):
Code
'#NoIndent: Don't want to lose our description annotations
'#Folder("Tests.Utils")
Option Explicit
Option Private Module
'Based on Python's math.isclose https://github.com/python/cpython/blob/17f94e28882e1e2b331ace93f42e8615383dee59/Modules/mathmodule.c#L2962-L3003
'math.isclose -> boolean
' a: double
' b: double
' relTol: double = 1e-09
' maximum difference for being considered "close", relative to the
' magnitude of the input values
' absTol: double = 0.0
' maximum difference for being considered "close", regardless of the
' magnitude of the input values
'Determine whether two floating point numbers are close in value.
'Return True if a is close in value to b, and False otherwise.
'For the values to be considered close, the difference between them
'must be smaller than at least one of the tolerances.
'-inf, inf and NaN behave similarly to the IEEE 754 Standard. That
'is, NaN is not close to anything, even itself. inf and -inf are
'only close to themselves.
'#Description("Determine whether two floating point numbers are close in value, accounting for special values in IEEE 754")
Public Function IsClose(ByVal a As Double, ByVal b As Double, _
Optional ByVal relTol As Double = 0.000000001, _
Optional ByVal absTol As Double = 0 _
) As Boolean
If relTol < 0# Or absTol < 0# Then
Err.Raise 5, Description:="tolerances must be non-negative"
ElseIf a = b Then
'Short circuit exact equality -- needed to catch two infinities of
' the same sign. And perhaps speeds things up a bit sometimes.
IsClose = True
ElseIf IsInfinity(a) Or IsInfinity(b) Then
'This catches the case of two infinities of opposite sign, or
' one infinity and one finite number. Two infinities of opposite
' sign would otherwise have an infinite relative tolerance.
'Two infinities of the same sign are caught by the equality check
' above.
IsClose = False
Else
'Now do the regular computation on finite arguments. Here an
' infinite tolerance will always result in the function returning True,
' since an infinite difference will be <= to the infinite tolerance.
'This is to supress overflow errors as we deal with infinity.
'NaN has already been filtered out in the equality checks earlier.
On Error Resume Next
Dim diff As Double: diff = Abs(b - a)
If diff <= absTol Then
IsClose = True
ElseIf diff <= CDbl(Abs(relTol * b)) Then
IsClose = True
ElseIf diff <= CDbl(Abs(relTol * a)) Then
IsClose = True
End If
On Error GoTo 0
End If
End Function
'#Description "Checks if Number is IEEE754 +/- inf, won't raise an error"
Public IsInfinity(ByVal Number As Double) As Boolean
On Error Resume Next 'in case of NaN
IsInfinity = Abs(Number) = PosInf
On Error GoTo 0
End Function
'#Description "IEEE754 -inf"
Public Property Get NegInf() As Double
On Error Resume Next
NegInf = -1 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 +inf"
Public Property Get PosInf() As Double
On Error Resume Next
PosInf = 1 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 signaling NaN (sNaN)"
Public Property Get NaN() As Double
On Error Resume Next
NaN = 0 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 quiet NaN (qNaN)"
Public Property Get QNaN() As Double
QNaN = -NaN
End Property
Updated to incorporate great feedback from Cristian Buse
Examples
The IsClose function can be used to check for absolute difference:
assert(IsClose(0, 0.0001233, absTol:= 0.001)) 'same to 3 d.p.?
... or relative difference:
assert(IsClose(1234.5, 1234.6, relTol:= 0.0001)) '0.01% relative difference?
... but generally you specify both and if either tolerance is met then the numbers are considered close. It has special handling of +-infinity which are only close to themselves, and NaN which is close to nothing (see the PEP for full justification, or my Code Review post where I'd love feedback on this code :)
The Currency data type may be a good alternative. It handles relatively large numbers with fixed four digit precision.
Work-a-round??
Not sure if this will answer all scenarios, but I ran into a problem comparing rounded double values in VBA. When I compared to numbers that appeared to be identical after rounding, VBA would trigger false in an if-then compare statement.
My fix was to run two conversions, first double to string, then string to double, and then do the compare.
Simulated Example
I did not record the exact numbers that caused the error mentioned in this post, and the amounts in my example do not trigger the problem currently and are intended to represent the type of issue.
Sub Test_Rounded_Numbers()
Dim Num1 As Double
Dim Num2 As Double
Let Num1 = 123.123456789
Let Num2 = 123.123467891
Let Num1 = Round(Num1, 4) '123.1235
Let Num2 = Round(Num2, 4) '123.1235
If Num1 = Num2 Then
MsgBox "Correct Match, " & Num1 & " does equal " & Num2
Else
MsgBox "Inccorrect Match, " & Num1 & " does not equal " & Num2
End If
'Here it would say that "Inccorrect Match, 123.1235 does not equal 123.1235."
End Sub
Sub Fixed_Double_Value_Type_Compare_Issue()
Dim Num1 As Double
Dim Num2 As Double
Let Num1 = 123.123456789
Let Num2 = 123.123467891
Let Num1 = Round(Num1, 4) '123.1235
Let Num2 = Round(Num2, 4) '123.1235
'Add CDbl(CStr(Double_Value))
'By doing this step the numbers
'would trigger if they matched
'100% of the time
If CDbl(CStr(Num1)) = CDbl(CStr(Num2)) Then
MsgBox "Correct Match"
Else
MsgBox "Inccorrect Match"
End If
'Now it says Here it would say that "Correct Match, 123.1235 does equal 123.1235."
End Sub
Depending on your situation and your data, and if you're happy with the level of precision shown by default, you can try comparing the string conversions of the numbers as a very simple coding solution:
if cstr(a) = cstr(b)
This will include as much precision as would be displayed by default, which is generally sufficient to consider the numbers equal.
This would be inefficient for very large data sets, but for me was useful when reconciling imported data which was identical but was not matching after storing the data in VBA Arrays.
Try to use Single values if possible.
Conversion to Double values generates random errors.
Public Sub Test()
Dim D01 As Double
Dim D02 As Double
Dim S01 As Single
Dim S02 As Single
S01 = 45.678 / 12
S02 = 45.678
D01 = S01
D02 = S02
Debug.Print S01 * 12
Debug.Print S02
Debug.Print D01 * 12
Debug.Print D02
End Sub
45,678
45,678
45,67799949646
45,6780014038086
I have trouble comparing 2 double in Excel VBA
suppose that I have the following code
Dim a as double
Dim b as double
a = 0.15
b = 0.01
After a few manipulations on b, b is now equal to 0.6
however the imprecision related to the double data type gives me headache because
if a = b then
//this will never trigger
end if
Do you know how I can remove the trailing imprecision on the double type?
You can't compare floating point values for equality. See this article on "Comparing floating point numbers" for a discussion of how to handle the intrinsic error.
It isn't as simple as comparing to a constant error margin unless you know for sure what the absolute range of the floats is beforehand.
if you are going to do this....
Dim a as double
Dim b as double
a = 0.15
b = 0.01
you need to add the round function in your IF statement like this...
If Round(a,2) = Round(b,2) Then
//code inside block will now trigger.
End If
See also here for additional Microsoft reference.
It is never wise to compare doubles on equality.
Some decimal values map to several floating point representations. So one 0.6 is not always equal to the other 0.6.
If we subtract one from the other, we probably get something like 0.00000000051.
We can now define equality as having a difference smaller that a certain error margin.
Here is a simple function I wrote:
Function dblCheckTheSame(number1 As Double, number2 As Double, Optional Digits As Integer = 12) As Boolean
If (number1 - number2) ^ 2 < (10 ^ -Digits) ^ 2 Then
dblCheckTheSame = True
Else
dblCheckTheSame = False
End If
End Function
Call it with:
MsgBox dblCheckTheSame(1.2345, 1.23456789)
MsgBox dblCheckTheSame(1.2345, 1.23456789, 4)
MsgBox dblCheckTheSame(1.2345678900001, 1.2345678900002)
MsgBox dblCheckTheSame(1.2345678900001, 1.2345678900002, 14)
As has been pointed out, many decimal numbers cannot be represented precisely as traditional floating-point types. Depending on the nature of your problem space, you may be better off using the Decimal VBA type which can represent decimal numbers (base 10) with perfect precision up to a certain decimal point. This is often done for representing money for example where 2-digit decimal precision is often desired.
Dim a as Decimal
Dim b as Decimal
a = 0.15
b = 0.01
Late answer but I'm surprised a solution hasn't been posted that addresses the concerns outlined in the article linked in the (currently) accepted answer, namely that:
Rounding checks equality with absolute tolerance (e.g. 0.0001 units if rounded to 4d.p.) which is rubbish when comparing different values on multiple orders of magnitude (so not just comparing to 0)
Relative tolerance that scales with one of the numbers being compared meanwhile is not mentioned in the current answers, but performs well on non-zero comparisons (however will be bad at comparing to zero as the scaling blows up around then).
To solve this, I've taken inspiration from Python: PEP 485 -- A Function for testing approximate equality to implement the following (in a standard module):
Code
'#NoIndent: Don't want to lose our description annotations
'#Folder("Tests.Utils")
Option Explicit
Option Private Module
'Based on Python's math.isclose https://github.com/python/cpython/blob/17f94e28882e1e2b331ace93f42e8615383dee59/Modules/mathmodule.c#L2962-L3003
'math.isclose -> boolean
' a: double
' b: double
' relTol: double = 1e-09
' maximum difference for being considered "close", relative to the
' magnitude of the input values
' absTol: double = 0.0
' maximum difference for being considered "close", regardless of the
' magnitude of the input values
'Determine whether two floating point numbers are close in value.
'Return True if a is close in value to b, and False otherwise.
'For the values to be considered close, the difference between them
'must be smaller than at least one of the tolerances.
'-inf, inf and NaN behave similarly to the IEEE 754 Standard. That
'is, NaN is not close to anything, even itself. inf and -inf are
'only close to themselves.
'#Description("Determine whether two floating point numbers are close in value, accounting for special values in IEEE 754")
Public Function IsClose(ByVal a As Double, ByVal b As Double, _
Optional ByVal relTol As Double = 0.000000001, _
Optional ByVal absTol As Double = 0 _
) As Boolean
If relTol < 0# Or absTol < 0# Then
Err.Raise 5, Description:="tolerances must be non-negative"
ElseIf a = b Then
'Short circuit exact equality -- needed to catch two infinities of
' the same sign. And perhaps speeds things up a bit sometimes.
IsClose = True
ElseIf IsInfinity(a) Or IsInfinity(b) Then
'This catches the case of two infinities of opposite sign, or
' one infinity and one finite number. Two infinities of opposite
' sign would otherwise have an infinite relative tolerance.
'Two infinities of the same sign are caught by the equality check
' above.
IsClose = False
Else
'Now do the regular computation on finite arguments. Here an
' infinite tolerance will always result in the function returning True,
' since an infinite difference will be <= to the infinite tolerance.
'This is to supress overflow errors as we deal with infinity.
'NaN has already been filtered out in the equality checks earlier.
On Error Resume Next
Dim diff As Double: diff = Abs(b - a)
If diff <= absTol Then
IsClose = True
ElseIf diff <= CDbl(Abs(relTol * b)) Then
IsClose = True
ElseIf diff <= CDbl(Abs(relTol * a)) Then
IsClose = True
End If
On Error GoTo 0
End If
End Function
'#Description "Checks if Number is IEEE754 +/- inf, won't raise an error"
Public IsInfinity(ByVal Number As Double) As Boolean
On Error Resume Next 'in case of NaN
IsInfinity = Abs(Number) = PosInf
On Error GoTo 0
End Function
'#Description "IEEE754 -inf"
Public Property Get NegInf() As Double
On Error Resume Next
NegInf = -1 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 +inf"
Public Property Get PosInf() As Double
On Error Resume Next
PosInf = 1 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 signaling NaN (sNaN)"
Public Property Get NaN() As Double
On Error Resume Next
NaN = 0 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 quiet NaN (qNaN)"
Public Property Get QNaN() As Double
QNaN = -NaN
End Property
Updated to incorporate great feedback from Cristian Buse
Examples
The IsClose function can be used to check for absolute difference:
assert(IsClose(0, 0.0001233, absTol:= 0.001)) 'same to 3 d.p.?
... or relative difference:
assert(IsClose(1234.5, 1234.6, relTol:= 0.0001)) '0.01% relative difference?
... but generally you specify both and if either tolerance is met then the numbers are considered close. It has special handling of +-infinity which are only close to themselves, and NaN which is close to nothing (see the PEP for full justification, or my Code Review post where I'd love feedback on this code :)
The Currency data type may be a good alternative. It handles relatively large numbers with fixed four digit precision.
Work-a-round??
Not sure if this will answer all scenarios, but I ran into a problem comparing rounded double values in VBA. When I compared to numbers that appeared to be identical after rounding, VBA would trigger false in an if-then compare statement.
My fix was to run two conversions, first double to string, then string to double, and then do the compare.
Simulated Example
I did not record the exact numbers that caused the error mentioned in this post, and the amounts in my example do not trigger the problem currently and are intended to represent the type of issue.
Sub Test_Rounded_Numbers()
Dim Num1 As Double
Dim Num2 As Double
Let Num1 = 123.123456789
Let Num2 = 123.123467891
Let Num1 = Round(Num1, 4) '123.1235
Let Num2 = Round(Num2, 4) '123.1235
If Num1 = Num2 Then
MsgBox "Correct Match, " & Num1 & " does equal " & Num2
Else
MsgBox "Inccorrect Match, " & Num1 & " does not equal " & Num2
End If
'Here it would say that "Inccorrect Match, 123.1235 does not equal 123.1235."
End Sub
Sub Fixed_Double_Value_Type_Compare_Issue()
Dim Num1 As Double
Dim Num2 As Double
Let Num1 = 123.123456789
Let Num2 = 123.123467891
Let Num1 = Round(Num1, 4) '123.1235
Let Num2 = Round(Num2, 4) '123.1235
'Add CDbl(CStr(Double_Value))
'By doing this step the numbers
'would trigger if they matched
'100% of the time
If CDbl(CStr(Num1)) = CDbl(CStr(Num2)) Then
MsgBox "Correct Match"
Else
MsgBox "Inccorrect Match"
End If
'Now it says Here it would say that "Correct Match, 123.1235 does equal 123.1235."
End Sub
Depending on your situation and your data, and if you're happy with the level of precision shown by default, you can try comparing the string conversions of the numbers as a very simple coding solution:
if cstr(a) = cstr(b)
This will include as much precision as would be displayed by default, which is generally sufficient to consider the numbers equal.
This would be inefficient for very large data sets, but for me was useful when reconciling imported data which was identical but was not matching after storing the data in VBA Arrays.
Try to use Single values if possible.
Conversion to Double values generates random errors.
Public Sub Test()
Dim D01 As Double
Dim D02 As Double
Dim S01 As Single
Dim S02 As Single
S01 = 45.678 / 12
S02 = 45.678
D01 = S01
D02 = S02
Debug.Print S01 * 12
Debug.Print S02
Debug.Print D01 * 12
Debug.Print D02
End Sub
45,678
45,678
45,67799949646
45,6780014038086
I wanted to perform a XOR calculation of two Binary numbers for example: on Sheet 1
Range A1 = 10101010
Range A2 = 11100010
Now I need to perform XOR of A1, A2 result in A3. I tried different formula's two perform XOR calculations like: A1^A2, (BITXOR (A1, A2)) but unfortunately it didn't worked I think because I am using excel 2007 "XOR" doesn't support.
I'm expecting a result of 1001000.
First, you should note that Excel pre-Excel2013 has no bitwise operators or functions built-in (Excel's OR() function is logical even if the operands are numeric). Excel 2013 finally adds this glaringly missing functionality.
Using VBA
The simplest way is to create a User Defined Function that does it. Formulae can work if you are prepared for either a decimal output, or helper columns, or a very repetitive Concatenate formula but VBA gets around these limitations - I recommend it if you are able to have code in the workbook.
Decimal Input, Decimal Output
The below examples just expose the built-in bitwise operators to use as functions in Excel formulae. I assume an integral type, although you could change it to accept decimals etc.
You can convert your string binary numbers (e.g. "1010") to decimals (10, for the previous example) using the BIN2DEC() function built-in to Excel, although this only handles 9 bits + sign bit, alternatively you can use an array formula to convert it for you (see my section on "Using Formulas" below).
Public Function BITWISE_OR(operand1, operand2)
BITWISE_OR = CLng(operand1) Or CLng(operand2)
End Function
Public Function BITWISE_AND(operand1, operand2)
BITWISE_AND = CLng(operand1) And CLng(operand2)
End Function
Public Function BITWISE_XOR(operand1, operand2)
BITWISE_XOR = CLng(operand1) Xor CLng(operand2)
End Function
Converting the numeric results back to binary strings is pretty annoying with formulas - if you need more than the range covered by DEC2BIN() (a paltry -512 to +511) function built in to Excel then I would suggest either using VBA (see below), or building up your binary string bit by bit using columns or rows (see my Using Formulas section below).
Binary string input, Binary string output
The below essentially iterates through a string setting each bit in turn based on the corresponding bits in the input strings. It performs the bit changes on the string in-place using Mid$ statement. Bit strings can be arbitrary length.
The below looks complicated but really it is the same basic stuff repeated 3 times for each of And, Or and XOr.
'str1, str2: the two bit strings. They can be different lengths.
'significantDigitsAreLeft: optional parameter to dictate how different length strings should be padded. Default = True.
Public Function Bitstr_AND(str1 As String, str2 As String, Optional significantDigitsAreLeft As Boolean = True)
Dim maxLen As Long, resStr As String, i As Long
If Len(str1) > Len(str2) Then maxLen = Len(str1) Else maxLen = Len(str2) 'get max length of the two strings
str1 = getPaddedString(str1, maxLen, significantDigitsAreLeft) 'pad left or right to the desired length
str2 = getPaddedString(str2, maxLen, significantDigitsAreLeft) 'pad left or right to the desired length
resStr = String$(maxLen, "0") 'prepare the result string into memory (Mid$ can operate without creating a new string, for performance)
For i = 1 To maxLen
If Mid$(str1, i, 1) = "1" And Mid$(str2, i, 1) = "1" Then
Mid$(resStr, i, 1) = "1" 'in-place overwrite of the existing "0" with "1"
End If
Next i
Bitstr_AND = resStr
End Function
'For explanatory comments, see Bitstr_AND
Public Function Bitstr_OR(str1 As String, str2 As String, Optional significantDigitsAreLeft As Boolean = True)
Dim maxLen As Long
Dim resStr As String
Dim i As Long
If Len(str1) > Len(str2) Then maxLen = Len(str1) Else maxLen = Len(str2)
str1 = getPaddedString(str1, maxLen, significantDigitsAreLeft)
str2 = getPaddedString(str2, maxLen, significantDigitsAreLeft)
resStr = String$(maxLen, "0")
For i = 1 To maxLen
If Mid$(str1, i, 1) = "1" Or Mid$(str2, i, 1) = "1" Then
Mid$(resStr, i, 1) = "1"
End If
Next i
Bitstr_OR = resStr
End Function
'For explanatory comments, see Bitstr_AND
Public Function Bitstr_XOR(str1 As String, str2 As String, Optional significantDigitsAreLeft As Boolean = True)
Dim maxLen As Long
Dim resStr As String
Dim i As Long
If Len(str1) > Len(str2) Then maxLen = Len(str1) Else maxLen = Len(str2)
str1 = getPaddedString(str1, maxLen, significantDigitsAreLeft)
str2 = getPaddedString(str2, maxLen, significantDigitsAreLeft)
resStr = String$(maxLen, "0")
For i = 1 To maxLen
If Mid$(str1, i, 1) = "1" Then
If Not Mid$(str2, i, 1) = "1" Then
Mid$(resStr, i, 1) = "1"
End If
ElseIf Mid$(str2, i, 1) = "1" Then 'Save an If check by assuming input string contains only "0" or "1"
Mid$(resStr, i, 1) = "1"
End If
Next i
Bitstr_XOR = resStr
End Function
'Helper to pad string
Private Function getPaddedString(str As String, length As Long, padLeft As Boolean) As String
If Len(str) < length Then
If padLeft Then
getPaddedString = String$(length - Len(str), "0") & str
Else
getPaddedString = str & String$(length - Len(str), "0")
End If
Else
getPaddedString = str
End If
End Function
Using Formulas
You can do an XOR operation using Text functions or Sumproduct. This may be more appropriate if you do not want to use VBA but formulas are painful to ensure they covers all situations, like negatives or different length binary strings. I refer you to the superb blog post http://www.excelhero.com/blog/2010/01/5-and-3-is-1.html for examples using Sumproduct, and http://chandoo.org/wp/2011/07/29/bitwise-operations-in-excel/ for examples using Text functions.
I cooked up my own formulae that handles certain cases and I explain them below to guide you.
Binary string Input, Decimal Output
In the below, A2 and B2 refer to the two binary numbers in up to 32-bits string form. The strings can be variable length, as the formula will pad with 0's to the necessary length. It should be obvious how to increase it to more bits. They must be entered using Ctrl+Shift+Enter.
The most significant bit is on the left. To make it least significant bit on the left, you can remove the little subtraction in the powers of 2 part, and make it pad to the right.
Bitwise And:
=SUM((((MID(REPT("0",32-LEN($A$2))&$A$2,ROW($1:$32),1)="1")+(MID(REPT("0",32-LEN($B$2))&$B$2,ROW($1:$32),1)="1"))=2)*(2^(32-ROW($1:$32))))
Bitwise Or:
=SUM((((MID(REPT("0",32-LEN($A$2))&$A$2,ROW($1:$32),1)="1")+(MID(REPT("0",32-LEN($B$2))&$B$2,ROW($1:$32),1)="1"))>0)*(2^(32-ROW($1:$32))))
Bitwise Xor:
=SUM((((MID(REPT("0",32-LEN($A$2))&$A$2,ROW($1:$32),1)="1")+(MID(REPT("0",32-LEN($B$2))&$B$2,ROW($1:$32),1)="1"))=1)*(2^(32-ROW($1:$32))))
Binary string input, Binary string Output
A single cell solution would be arduous because there is no array concatenation formula in Excel. You could do it using the CONCATENATE function glueing together each bits, with each bit being the result of an If comparing each binary string returning 1 or 0 as appropriate. As I said, though easy (just build it up like =IF(Mid(A1,1,1) = "1",...), this would be boring so I personally won't do it for you ;)
Alternatively, you could do it more simply using columns or rows to build up the string, like:
If A1 and B1 have your binary strings, then in C1 put (for AND, or for OR change the =2 at the end to >0 and for XOR change it to =1):
=IF((MID($A1,1,1)="1")+(MID($B1,1,1)="1"))=2,"1","0")
Then in D1 put:
=C1 & IF((MID($A1,COLUMN()-COLUMN($C1),1)="1")+(MID($B1,COLUMN()-COLUMN($C1),1)="1"))=2,"1","0")
Then drag this across as many columns as bits
So I'm calculating basic statistics in my worksheet and it includes code such as:
xxx = Application.worksheetfunction.average(etc etc etc
yyy = Application.worksheetfunction.min(etc etc etc
zzz = Application.worksheetfunction.max(etc etc etc
My question: Is there an RMS equivalent function where I can simply plug it in place of where I have 'average, min, max' functions in that code? And if there isn't then what would be the most efficient means to code in to find RMS solutions?
I hope I've stated the goal clearly enough. I'm curious as to whether or not there is a predefined RMS function for VBA or whether or not I've got to create some sort of user defined function? ~ That of which I'm fairly new to as well so if there isn't a simple line of code to write for this, I'll have to do more reading on UDF's.
EDIT:
I've got around 30,000 rows, and for simplicity's sake: imagine two columns. Column A has the year i.e. 1941 or anything else through 2008. Column B is a numeric value. I'm just trying to put code together that gives decade summaries of Average, Min, Max, and the RMS values.
You can do the average with
=SQRT(SUMSQ(A:A)/COUNTA(range))
or in VBA:
r = (Application.WorksheetFunction.SumSq(Range("A:A")) / Range("A:A").Count) ^ (1 / 2)
A VBA function that accepts arrays (any rank) and ranges with multiple areas (a discontinuous range like A4:B6,C11:D15), or even a union of ranges in a formula. It skips non number datatypes (including dates, boolean, blanks etc).
You can use it in VBA code, or as a UDF in a worksheet formula such as:
"=RMS(A1:A10)" (basic usage)
"=RMS(A1:A10,C1:C10)" (multiple ranges (or arrays for that matter))
"{=RMS({1,2,3,4})}" (array formula entered with Ctrl+shift+enter)
Function RMS(ParamArray args()) As Double
Dim arg, arr, area As Range, ss As Double, n As Long
For Each arg In args
If TypeOf arg Is Range Then
For Each area In arg.Areas
arr = area.value
If VarType(arr) < vbArray Then
queryRmsElements Array(arr), ss, n
Else
queryRmsElements arr, ss, n
End If
Next area
ElseIf VarType(arg) > vbArray Then
queryRmsElements arg, ss, n
Else
Err.Raise 1, "RMS", "Invalid Argument"
End If
Next arg
RMS = (ss / n) ^ 0.5
End Function
Private Sub queryRmsElements(ByRef elements, ByRef ss As Double, ByRef n As Long)
Static element As Variant
'Enumerate to cover rank > 1 (vs. Iterate)
For Each element In elements
Select Case VarType(element)
Case VbVarType.vbByte, _
VbVarType.vbCurrency, _
VbVarType.vbDecimal, _
VbVarType.vbDouble, _
VbVarType.vbInteger, _
VbVarType.vbLong, _
VbVarType.vbSingle
ss = element ^ 2 + ss
n = n + 1
Case Else
End Select
Next element
End Sub
This one worked for me:
Function RMS(Intervalo As Range)
Dim SomaQ As Double
Dim Tamanho As Integer
SomaQ = 0
Tamanho = Intervalo.Count
SomaQ = Application.WorksheetFunction.SumSq(Intervalo)
RMS = Sqr(SomaQ / Tamanho)
End Function
I need to truncate the amount of decimal places of my double value for display in a textbox. How would one achieve this with vba?
If you want to round the value, then you can use the Round function (but be aware that VBA's Round function uses Banker's rounding, also known as round-to-even, where it will round a 5 up or down; to round using traditional rounding, use Format).
If you want to truncate the value without rounding, then there's no need to use strings as in the accepted answer - just use math:
Dim lDecimalPlaces As Long: lDecimalPlaces = 2
Dim dblValue As Double: dblValue = 2.345
Dim lScale = 10 ^ lDecimalPlaces
Dim dblTruncated As Double: dblTruncated = Fix(dblValue * lScale) / lScale
This yields "2.34".
You can either use ROUND for FORMAT in VBA
For example to show 2 decimal places
Dval = 1.56789
Debug.Print Round(dVal,2)
Debug.Print Format(dVal,"0.00")
Note: The above will give you 1.57. So if you are looking for 1.56 then you can store the Dval in a string and then do this
Dim strVal As String
dVal = 1.56789
strVal = dVal
If InStr(1, strVal, ".") Then
Debug.Print Split(strVal, ".")(0) & "." & Left(Split(strVal, ".")(1), 2)
Else
Debug.Print dVal
End If
You can use Int() function. Debug.print Int(1.99543)
Or Better:
Public Function Trunc(ByVal value As Double, ByVal num As Integer) As Double
Trunc = Int(value * (10 ^ num)) / (10 ^ num)
End Function
So you can use Trunc(1.99543, 4) ==> result: 1.9954
This was my attempt:
Function TruncateNumber(decimalNum As Double, decPlaces As Integer) As Double
'decimalNum: the input number to be truncated
'decPlaces: how many decimal places to round to. Use 0 for no decimal places.
decimalLocation = InStr(decimalNum, ".")
TruncateNumber = Left(decimalNum, decimalLocation + decPlaces)
End Function
It uses strings to avoid any math errors caused by different rounding methods. It will output as a type double, so you can still perform your own math on it.
This will cause an error if a number without a decimal place is passed into the above function. If this is a concern, you can use the following code instead:
Function TruncateNumber(decimalNum As Double, decPlaces As Integer) As Double
'decimalNum: the input number to be truncated
'decPlaces: how many decimal places to round to. Use 0 for no decimal places.
If InStr(decimalNum, ".") = 0 Then 'if there was no decimal:
'then return the number that was given
TruncateNumber = decimalNum
Else 'if there is a decimal:
'then return the truncated value as a type double
decimalLocation = InStr(decimalNum, ".")
TruncateNumber = Left(decimalNum, decimalLocation + decPlaces)
End If
End Function
Hopefully these functions are of some use to someone. I haven't done extensive testing, but they worked for me.
EDITED
Newer version of Excel (VBA) have a TRUNC function which already does things properly.
For older versions of EXCEL
I wanted to truncate a double into an integer.
value = Int(83.768)
value == 83
Awesome, it worked.
Depending on your version of Excel (VB) this might not work with negative numbers.
value = Int(-83.768)
value == -84
VB uses Banker rounding.
Public Function Trunc1(ByVal value As Double) As Integer
' Truncate by calling Int on the Absolute value then multiply by the sign of the value.
' Int cannot truncate doubles that are negative
Trunc1 = Sgn(value) * Int(Abs(value))
End Function
If you want specific decimal places do what Makah did only with Abs around the value so Int can truncate properly.
Public Function Trunc2(ByVal value As Double, Optional ByVal num As Integer = 1) As Double
' Truncate by calling Int on the Absolute value then multiply by the sign of the value.
' Int cannot truncate doubles that are negative
Trunc2 = Sgn(value) * (Int(Abs(value) * (10 ^ num)) / (10 ^ num))
End Function
Here is a little experiment I did... (1st time posting and answer, please tell me if I am not following conventions.
Sub Truncate()
Dim dblNum As Double
Dim intDecimal As Integer
dblNum = 1578.56789
intDecimal = 2 '0 returns 1578
'2 returns 1578.56
'-2 returns 1500
Debug.Print (Int(dblNum * 10 ^ intDecimal) / 10 ^ intDecimal)
End Sub