How do i decode %C3%B8 in VBA? it is the danish letter ΓΈ -
It is encoded in UTF-8. I have tried to decode it in vba for use in a excel sppreadsheet with the following function:
Function DecodeUTF8(s)
Dim i
Dim c
Dim n
i = 1
Do While i <= Len(s)
c = Asc(Mid(s, i, 1))
If c And &H80 Then
n = 1
Do While i + n < Len(s)
If (Asc(Mid(s, i + n, 1)) And &HC0) <> &H80 Then
Exit Do
End If
n = n + 1
Loop
If n = 2 And ((c And &HE0) = &HC0) Then
c = Asc(Mid(s, i + 1, 1)) + &H40 * (c And &H1)
Else
c = 191
End If
s = Left(s, i - 1) + Chr(c) + Mid(s, i + n)
End If
i = i + 1
Loop
DecodeUTF8 = s
End Function
You have to use UrlDecode or HmlDecode methods
see here for more information
http://msdn.microsoft.com/en-us/library/system.web.httputility.urldecode.aspx
or here
http://msdn.microsoft.com/en-us/library/7c5fyk1k.aspx
Related
I have been reading on some of the posts that others were having similar issues for comparing text strings in cells.
The results were close but not quite what the goal is so I a confident that I will get the results.
The image attached is just the desired result. Goal: Compare Old SQL (Column B) to New SQL(Column A)/change font color of the difference in Column A (if any).
image attached shows the desired result
Being 20 yrs removed, I am beyond rusty.
I have tried the leverstein (?? sorry forget the author); tried dupeword and a couple others. Just havent found the right code. I am going to keep looking at examples - I am sure someone has figured it out - just not me.
Public Sub AlignStrings()
Dim a() As Byte, b() As Byte, a_$, b_$, i&, j&, d&, u&, l&, x&, y&, f&()
Const GAP = -1
Const PAD = "$"
a = [a3].Text: b = [b3].Text 'column A &B needs to be a range
'[c2:d2].Clear
'[a1:a6].Font.Name = "Calibri"
ReDim f(0 To UBound(b) \ 2 + 1, 0 To UBound(a) \ 2 + 1)
For i = 1 To UBound(f, 1)
For j = 1 To UBound(f, 2)
x = j - 1: y = i - 1
If a(x * 2) = b(y * 2) Then
d = 1 + f(y, x)
u = 0 + f(y, j)
l = 0 + f(i, x)
Else
d = -1 + f(y, x)
u = GAP + f(y, j)
l = GAP + f(i, x)
End If
f(i, j) = Max(d, u, l)
Next
Next
i = UBound(f, 1): j = UBound(f, 2)
On Error Resume Next
Do
x = j - 1: y = i - 1
d = f(y, x)
u = f(y, j)
l = f(i, x)
Select Case True
Case Err
If y < 0 Then GoTo left Else GoTo up
Case d >= u And d >= l Or Mid$(a, j, 1) = Mid$(b, i, 1)
diag:
a_ = Mid$(a, j, 1) & a_
b_ = Mid$(b, i, 1) & b_
i = i - 1: j = j - 1
Case u > l
up:
a_ = PAD & a_
b_ = Mid$(b, i, 1) & b_
i = i - 1
Case l > u
left:
a_ = Mid$(a, j, 1) & a_
b_ = PAD & b_
j = j - 1
End Select
Loop Until i < 1 And j < 1
DecorateStrings a_, b_, [a3], [b3], PAD 'output needs to be in same
columns/range
I want to write a function in which I can include an array. I imagine that the function will work like the function NPV, we have 3 ways of specifying the syntax in the formula bar:
1) NPV(0.5, A1:A5)
2) NPV(0.5, A1, A2, A3, A4, A5)
3) NPV(0.5, {10, 20, 23, 25, 27})
Where 10, 20, 23, 25, 27 are the value in range A1:A5.
And here is my function in VBA:
Function MyNpv(r As Double, Flows As Variant)
Dim i, n As Integer
Dim p As Double
n = Application.Count(Flows)
For i = 1 To n
p = p + Flows(i) / (r + 1) ^ i
Next i
MyNpv = p
End Function
However, my own function can only work like:
MyNpv(0.5, A1:A5)
Is there anyway that I can declare my array so that it would work flexibly like the function NPV?
Thanks.
Use a ParamArray, Loop that to test what is in each part of the array and then adjust accordingly:
Function MyNpv(r As Double, ParamArray Flows() As Variant)
Dim FlowsPart As Variant
Dim p As Double
p = 0#
Dim k As Long
k = 1
For Each FlowsPart In Flows
Dim arr As Variant
arr = FlowsPart
Dim x As Long
x = -1
Dim y As Long
y = -1
On Error Resume Next
x = UBound(arr, 2)
y = UBound(arr)
On Error GoTo 0
Dim j As Long
Dim i As Long
If x >= 0 And y >= 0 Then
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
p = p + arr(i, j) / (r + 1) ^ k
k = k + 1
Next j
Next i
ElseIf y >= 0 Then
For j = LBound(arr) To UBound(arr)
p = p + arr(j) / (r + 1) ^ k
k = k + 1
Next j
Else
p = p + arr / (r + 1) ^ k
k = k + 1
End If
Next FlowsPart
MyNpv = p
End Function
I'm trying to use this VBA code to price American or European options... But I run into
"Compile error: Can't find project or library"
with dt =T/n highlighted.
I can't determine what is wrong. Hoping someone smarter than I can point out what I'm overlooking.
Function CRRTree(Spot, K, T, rf, vol, n, OpType As String, ExType As String)
dt = T / n
u = Exp(vol * (dt ^ 0.5))
d = 1 / u
p = (Exp(rf * dt) - d) / (u - d)
' Tree for stock price
Dim S() As Double
ReDim S(n + 1, n + 1) As Double
For i = 1 To n + 1
For j = i To n + 1
S(i, j) = Spot * u ^ (j - i) * d ^ (i - 1)
Next j
Next i
' Calculate Terminal Price for Calls and Puts
Dim Op() As Double
ReDim Op(n + 1, n + 1) As Double
For i = 1 To n + 1
Select Case OpType
Case "C": Op(i, n + 1) = Application.Max(S(i, n + 1) - K, 0)
Case "P": Op(i, n + 1) = Application.Max(K - S(i, n + 1), 0)
End Select
Next i
' Calculate Remaining entries for Calls and Puts
For j = n To 1 Step -1
For i = 1 To j
Select Case ExType
Case "A":
If OpType = "C" Then
Op(i, j) = Application.Max(S(i, j) - K, Exp(-rf * dt) * (p * Op(i, j + 1) + (1 - p) * Op(i + 1, j + 1)))
ElseIf OpType = "P" Then
Op(i, j) = Application.Max(K - S(i, j), Exp(-rf * dt) * (p * Op(i, j + 1) + (1 - p) * Op(i + 1, j + 1)))
End If
Case "E":
Op(i, j) = Exp(-rf * dt) * (p * Op(i, j + 1) + (1 - p) * Op(i + 1, j + 1))
End Select
Next i
Next j
CRRTree = Op(1, 1)
End Function
Could anyone help me with the formula to calculate the decimal value of an IPv6 address?
I need to put the formula in VBA to make a custom excel formula. I know the formula for IPv4 and I have read it is similar but I can not seem to figure it out. I need this to be able to map a IPv6 address to a range in the ip2location CSV.
A decimal value of an IPv6 address would be to big. You would need a 128bit unsigned integer but there is no such data type in VBA.
So as far as I know you can't manipulate IPv6 addresses as integers.
I have some Excel IP functions which you should be able to start with.
=SubnetIPv4(IPv4,Bits,Offset) =IsIPv4(IPv4)
IP Address Bits Offset Result Result
10.11.12.13 26 0 10.11.12.0 TRUE
Notes:
Macros must be enabled
IPv4 is a string representing an IPv4 address in dotted decimal format
Bits is an integer (0 to 32) representing the number of mask bits
Offset is an integer representing the host address offset into the subnet
Using Offset 0 will retun a subnet for any IP address
Using IPv4 of 255.255.255.255 and Offset 0 will retun a mask of Bits size
=SubnetIPv6(IPv6,Bits,Offset) =IsIPv6(IPv6)
IP Address Bits Offset Result Result
fe80::1dce:e8b3:1a14:2c3b 10 :: FE80:0:0:0:0:0:0:0 TRUE
Notes:
Macros must be enabled
IPv6 is a string representing an IPv6 address in standard format (leading 0s are optional and :: works)
Bits is an integer (0 to 128) representing the number of mask bits
Offset is a string representing the host address offset into the subnet in standard format (leading 0s are optional and :: works)
Using Offset equivalent to 0 (::, ::0, 0:0:0:0:0:0:0:0, etc.) will retun a subnet for any IP address
Using IPv6 of FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF and Offset equivalent to 0 will retun a mask of Bits size
Function CountStr(Source As String, Target As String) As Integer
Dim c, i As Integer
c = 0
If Not ((Source = "") Or (Target = "")) Then
For i = 1 To Len(Source)
If Mid(Source, i, Len(Target)) = Target Then
c = c + 1
End If
Next
End If
CountStr = c
End Function
Function SubnetIPv4(IPv4 As String, Bits As Integer, Offset As Long) As String
Dim a() As String
Dim c, d, i As Integer
Dim m As Long
Dim s As String
If IPv4 = "" Then
GoTo InvalidIPv4
End If
c = CountStr(IPv4, ".")
If c <> 3 Then
GoTo InvalidIPv4
End If
c = CountStr(IPv4, "..")
If c > 1 Then
GoTo InvalidIPv4
End If
If (Left(IPv4, 1) = ".") Or (Right(IPv4, 1) = ".") Then
GoTo InvalidIPv4
End If
a = Split(IPv4, ".")
If UBound(a) <> 3 Then
GoTo InvalidIPv4
End If
On Error GoTo InvalidIPv4
For i = 0 To 3
If (Len(a(i)) > 0) And (Len(a(i)) < 4) Then
a(i) = CInt(a(i))
If (a(i) < 0) Or (a(i) > 255) Then
GoTo InvalidIPv4
End If
Else
GoTo InvalidIPv4
End If
Next
If (Bits < 0) Or (Bits > 32) Then
GoTo InvalidIPv4
End If
c = Bits Mod 8
d = Bits \ 8
If (Bits <> 0) And (c = 0) Then
c = 8
d = d - 1
End If
m = 0
For i = 0 To 7
m = m * 2
If c > 0 Then
m = m + 1
c = c - 1
End If
Next
a(d) = CStr(CLng(a(d)) And m)
For i = d + 1 To 3
a(i) = "0"
Next
If Offset < 0 Then
GoTo InvalidIPv4
End If
m = 0
For i = 1 To (32 - Bits)
m = m * 2
m = m + 1
Next
If Offset > m Then
GoTo InvalidIPv4
End If
m = Offset
For i = 3 To 0 Step -1
a(i) = a(i) + (m Mod 256)
m = m \ 256
Next
s = ""
For i = 0 To 3
s = s + CStr(a(i)) + "."
Next
s = Left(s, Len(s) - 1)
SubnetIPv4 = s
Exit Function
InvalidIPv4:
Error (3)
End Function
Function IsIPv4(IPv4 As String) As Boolean
Dim s As String
On Error GoTo InvalidIPv4
s = SubnetIPv4(IPv4, 32, 0)
IsIPv4 = True
Exit Function
InvalidIPv4:
IsIPv4 = False
End Function
Function SubnetIPv6(IPv6 As String, Bits As Integer, Offset As String) As String
Dim a() As String
Dim c, d, i As Integer
Dim m As Long
Dim s, t As String
If IPv6 = "" Then
GoTo InvalidIPv6
End If
c = CountStr(IPv6, ":")
If (c < 2) Or (c > 8) Then
GoTo InvalidIPv6
End If
d = CountStr(IPv6, "::")
If d > 1 Then
GoTo InvalidIPv6
End If
If (Left(IPv6, 1) = ":") And (Not (Left(IPv6, 2) = "::")) Then
GoTo InvalidIPv6
End If
If (Right(IPv6, 1) = ":") And (Not (Right(IPv6, 2) = "::")) Then
GoTo InvalidIPv6
End If
s = IPv6
If d = 1 Then
If Left(s, 2) = "::" Then
s = "0" + s
End If
If Right(s, 2) = "::" Then
s = s + "0"
End If
t = ":"
For i = c To 7
t = t + "0:"
Next
s = Replace(s, "::", t)
End If
a = Split(s, ":")
If UBound(a) <> 7 Then
GoTo InvalidIPv6
End If
On Error GoTo InvalidIPv6
For i = 0 To 7
If (Len(a(i)) > 0) And (Len(a(i)) < 5) Then
a(i) = WorksheetFunction.Hex2Dec(a(i))
Else
GoTo InvalidIPv6
End If
Next
If (Bits < 0) Or (Bits > 128) Then
GoTo InvalidIPv6
End If
c = Bits Mod 16
d = Bits \ 16
If (Bits <> 0) And (c = 0) Then
c = 16
d = d - 1
End If
m = 0
For i = 0 To 15
m = m * 2
If c > 0 Then
m = m + 1
c = c - 1
End If
Next
a(d) = CStr(CLng(a(d)) And m)
For i = d + 1 To 7
a(i) = "0"
Next
If Offset = "" Then
GoTo InvalidIPv6
End If
c = CountStr(Offset, ":")
If (c < 2) Or (c > 8) Then
GoTo InvalidIPv6
End If
d = CountStr(Offset, "::")
If d > 1 Then
GoTo InvalidIPv6
End If
If (Left(Offset, 1) = ":") And (Not (Left(Offset, 2) = "::")) Then
GoTo InvalidIPv6
End If
If (Right(Offset, 1) = ":") And (Not (Right(Offset, 2) = "::")) Then
GoTo InvalidIPv6
End If
s = Offset
If d = 1 Then
If Left(s, 2) = "::" Then
s = "0" + s
End If
If Right(s, 2) = "::" Then
s = s + "0"
End If
t = ":"
For i = c To 7
t = t + "0:"
Next
s = Replace(s, "::", t)
End If
b = Split(s, ":")
If UBound(b) <> 7 Then
GoTo InvalidIPv6
End If
On Error GoTo InvalidIPv6
For i = 0 To 7
If (Len(b(i)) > 0) And (Len(b(i)) < 5) Then
b(i) = WorksheetFunction.Hex2Dec(b(i))
Else
GoTo InvalidIPv6
End If
Next
c = Bits Mod 16
d = Bits \ 16
If (Bits <> 0) And (c = 0) Then
c = 16
d = d - 1
End If
m = 0
For i = 0 To 15
m = m * 2
If c > 0 Then
m = m + 1
c = c - 1
End If
Next
For i = 0 To d - 1
If b(i) <> "0" Then
GoTo InvalidIPv6
End If
Next
If b(d) <> CStr(CLng(b(d)) And m) Then
GoTo InvalidIPv6
End If
For i = 7 To d Step -1
a(i) = CStr(CLng(a(i)) + CLng(b(i)))
Next
s = ""
For i = 0 To 7
s = s + WorksheetFunction.Dec2Hex(a(i)) + ":"
Next
s = Left(s, Len(s) - 1)
SubnetIPv6 = s
Exit Function
InvalidIPv6:
Error (3)
End Function
Function IsIPv6(IPv6 As String) As Boolean
Dim s As String
On Error GoTo InvalidIPv6
s = SubnetIPv6(IPv6, 128, "::")
IsIPv6 = True
Exit Function
InvalidIPv6:
IsIPv6 = False
End Function
I want this code to search the column name called((attribute value1,attribute value2..N)
If that column contains fraction values, it should convert it to decimal. I'm using this macros(VBA).
The code is working but it is converting only one column(attribute value1).
It will take more time because I have multiple columns(attribute value2...N) that have fraction values.
Please help me out I am struck here.
Sub deci()
Dim LR As Long
Dim Dash As Long
Dim Whole As Double
Dim lngDataColumn As Long
Dim pi
lngDataColumn = 4
Sheets("Sheet3").Select
LR = Cells(Rows.Count, lngDataColumn).End(xlUp).row
For r = 2 To LR
s = Cells(r, lngDataColumn)
arr = Split(s, ",")
For i = LBound(arr) To UBound(arr)
Whole = 0
P = InStr(arr(i), " IN")
If P > 0 Then
Worksheet = (Left((arr(i)), P - 1))
Else
Worksheet = arr(i)
End If
Dash = InStr(Worksheet, "-")
If Dash > 0 Then
Whole = Frac(Left(Worksheet, Dash - 1))
Worksheet = Mid(Worksheet, Dash + 1)
End If
af = Right(arr(i), Len(arr(i)) - P + 1)
evfrac = Whole + Left(CStr(Evaluate(Worksheet)), 5)
' evfrac = Whole + Format(Evaluate(frac), "0.###")
ss = ss & evfrac & af & ", "
Next i
Cells(r, lngDataColumn) = Left(ss, Len(ss) - 2)
ss = ""
Next r
End Sub
Function Frac(ByVal X As String) As Double
Dim P As Integer, N As Double, Num As Double, Den As Double
X = Trim$(X)
P = InStr(X, "/")
If P = 0 Then
N = Val(X)
Else
Den = Val(Mid$(X, P + 1))
If Den = 0 Then Err.Raise 11 ' Divide by zero
X = Trim$(Left$(X, P - 1))
P = InStr(X, " ")
If P = 0 Then
Num = Val(X)
Else
Num = Val(Mid$(X, P + 1))
N = Val(Left$(X, P - 1))
End If
End If
If Den <> 0 Then
N = N + Num / Den
End If
Frac = N
End Function
The reason it's only doing one column is because that's exactly what your telling it to do with this section of the code:
lngDataColumn = 4
Sheets("Sheet3").Select
LR = Cells(Rows.Count, lngDataColumn).End(xlUp).row
Because your setting lngDataColumn as a fixed figure, your code is only executed on column 4. If you want to do more columns as a loop, you need to increment this value in the same maner you are incrementing r in your for loop.
For example:
lngDataColumn = 10
Sheets("Sheet3").Select
For 4 To lngDataColumn
LR = Cells(Rows.Count, lngDataColumn).End(xlUp).row
'Rest of code
Next lngDataColumn