A little new here! I am trying to calculate the Mahalanobis distance between 2 vectors, for which I need to calculate the covariance matrix between 2 vectors.
I have the following code to do this: basically the vectors are row vectors of size 1x8..these are stored in the variables x1 and x2. A difference of these 2 is then taken and stored in diff.
There is a separate function to calculate the covariance matrix and this is stored in covar1.
However when I execute this, I get a runtime error 1004 on the line calculating the inverse of the covariance matrix:
covarinv = WorksheetFunction.MInverse(covar1)
Any help on this would be immensely appreciated!
Thank you.
Sub calculat()
Dim x1() As Variant
Dim x2() As Variant
Dim diff() As Variant
Dim covar1 As Variant
Dim covarinv As Variant
Dim md() As Variant
x1 = Range("b3:i3")
x2 = Range("b4:i4")
n1 = UBound(x1, 1)
n2 = UBound(x1, 2)
m1 = UBound(x2, 1)
m2 = UBound(x2, 2)
ReDim diff(1 To n1, 1 To n2)
For j = 1 To n1
For i = 1 To n2
diff(j, i) = x1(j, i) - x2(j, i)
Next i
Next j
covar1 = VarCov(Range("b3:i7"))
covarinv = WorksheetFunction.MInverse(covar1)
temp = WorksheetFunction.MMult(diff, covarinv)
difft = WorksheetFunction.Transpose(diff)
md = WorksheetFunction.MMult(temp, difft)
End Sub
Function VarCov(rng As Range) As Variant
Dim i As Integer
Dim j As Integer
Dim colnum As Integer
Dim matrix() As Double
colnum = rng.Columns.Count
ReDim matrix(colnum - 1, colnum - 1)
For i = 1 To colnum
For j = 1 To colnum
matrix(i - 1, j - 1) = Application.WorksheetFunction.covar(rng.Columns(i), rng.Columns(j))
Next j
Next i
VarCov = matrix
End Function
Related
I have VBA code that calculates the CRC16 CCITT value of a text string, and now I am planning to use it on a Google Sheet, but do not have any idea how to convert the VBA code to Google Apps Script.
Function crc_ccitt_ffff(strParam As String) As String
Const CRC_POLY_CCITT As Long = &H1021&
Const CRC_START_CCITT_FFFF As Long = &HFFFF&
Dim crc_tabccitt(0 To 255) As Long, crc As Long, b() As Byte, c As Long, i As Long, j As Long
For i = 0 To 255
crc = 0
c = i * 256
For j = 0 To 7
If (crc Xor c) And 32768 Then
crc = (crc * 2) Xor CRC_POLY_CCITT
Else
crc = crc * 2
End If
c = c * 2
Next j
crc_tabccitt(i) = crc
Next i
b = strParam
crc = CRC_START_CCITT_FFFF
For i = 0 To UBound(b) Step 2
crc = (crc * 256) Xor crc_tabccitt(((crc \ 256) Xor b(i)) And 255)
crc = ((crc \ 65536) * 65536) Xor crc
Next i
crc_ccitt_ffff = Hex(crc)
End Function
Test vector:
00020101021129370016A000000677010111021312345678901215802TH5406500.5553037646304
Expected result: 3D85
Try the function below. This code gets the expected result for the test string you quote.
This custom function will work with a single text string argument, or a range of cells that contain text strings. It only calculates a checksum for text strings — empty cells and numeric cells are ignored.
/**
* Calculates a CRC-16/CCITT-FALSE checksum.
*
* #param {A2:D42} text A range of text strings for which to calculate checksums.
* #param {true} hex_output Use true to get hexadecimal results, and false to get decimal results. Defaults to true.
* #return {String[][]} The hexadecimal or decimal checksums for text.
* #customfunction
*/
function crc_ccitt_ffff(text, hex_output = true) {
// adapted from https://github.com/damonlear/CRC16-CCITT
// by https://stackoverflow.com/users/13045193/doubleunary
// for https://stackoverflow.com/q/68235740/13045193
// 在线校验工具及相关说明：http://www.ip33.com/crc.html
if (!Array.isArray(text))
text = [[text]];
const polynomial = 0x1021;
return text.map(row => row.map(string => {
if (!string.length)
return null;
const bytes = Array.from(String(string))
.map(char => char.charCodeAt(0) & 0xff); // gives 8 bits; higher bits get discarded
let crc = 0xffff;
bytes.forEach(byte => {
for (let i = 0; i < 8; i++) {
let bit = 1 === (byte >> (7 - i) & 1);
let c15 = 1 === (crc >> 15 & 1);
crc <<= 1;
if (c15 ^ bit)
crc ^= polynomial;
}
});
crc &= 0xffff;
return hex_output ? crc.toString(16).toUpperCase() : crc;
}));
}
I'm still new with the vba. I have an database that with the help of others peoples I've finally able to do validation check when importing. However, I can get check done with numbers as text, but if I need alpha character or if the cell is blank I'm stuck. This is what I have for numbers as text. I need two checks: 1) accept alphanumeric or blank (null) and 2)numeric or blank (null).
Function chk2(A As String) As Boolean
Dim i As Integer, l As Integer, c As String
l = Len(A)
If l = 4 Then
chk2 = True
For i = 1 To l
c = Mid(A, i, 1)
If Not (c >= "0" And c <= "9") Then
chk2 = False
Exit Function
End If
Next i
End If
End Function
This one works fine as long as there are characters to fill in each row/cell.
Thanks in advance for your help.
If you're returning a boolean value, you should only return a true value if everything has executed correctly, that way you aren't getting a false positive if something fails.
You could use a check if the cell has 0 length for a blank cell, i.e. If Len = 0
What you are doing in your If Not statement is checking if the ascii value of c is between the ascii values of 0 and 9 so you can use or statements to check if it is between a and z or A and Z or if there is a space which is character 32 - Chr(32) :
Function chk2(A As String) As Boolean
Dim i As Integer, l As Integer, c As String
chk2 = false
l = Len(A)
If l = 0 then
'do something if the cell is blank
chk2 = true
ElseIf l = 4 Then
For i = 1 To l
c = Mid(A, i, 1)
If Not ((c >= "0" And c <= "9") Or (c >= "a" And c <= "z") Or (c >= "A" And C <= "Z") Or c = Chr(32)) Then
Exit Function
End If
Next i
chk2=true
End If
End Function
I am using this code to compute the individual values listed below:
Item A 100
Item B 200
Item C 300
GRAND TOTAL 600
Function SumLookup(ByVal items As Object()) As Decimal
If items Is Nothing Then
Return Nothing
End If
Dim suma As Decimal = New Decimal()
Dim ct as Integer = New Integer()
suma = 0
ct = 0
For Each item As Object In items
suma += Convert.ToDecimal(item)
ct += 1
Next
If (ct = 0) Then return 0 else return suma
End Function
How can I compute the GRAND TOTAL value of 600?
Im trying to cycle through certain rows in my excel spreadsheet. for the first group im trying to cycle through every 3 rows to see if its hidden and for the second for loop I am stepping through every 2. I basically want to add whats true through both loops and return that value. the "Return y" part is giving me an error.
Function FindHiddenRows() As Integer
Dim x As Integer
Dim y As Integer
y = 0
For x = 23 To 38 Step 3
If Rows("x:x").EntireRow.Hidden = False Then
y = y + 1
End If
Next x
For x = 40 To 46 Step 2
If Rows("x:x").EntireRow.Hidden = False Then
y = y + 1
End If
Next x
Return y
End Function
to make it fast / short / easy:
Function FindHiddenRows() As Byte
Dim x As Byte, y As Byte
For x = 22 To 46 Step 2
If x < 38 Then x = x + 1
If Not Rows(x).Hidden Then y = y + 1
Next
FindHiddenRows = y
End Function
I have the following code and I get the following error:
Compile error, variable not found (it is not able to find j)
Also, even though I provide MktVol as a vector of length 4, the message box returns N=0
Can you please help me fix my mistake.
Public Function EstimateAllParameters(params, MktStrike, MktVol, F, T, b)
Dim R As Double, a As Double, V As Double, N As Integer
Dim j as integer 'stops the compile error but the function returns #VALUE!
Dim ModelVol() As Double, sqdError() As Double
R = params(1)
V = params(2)
a = params(3)
N = MktVol.Length
MsgBox ("N= " & N)
For j = 1 To N
ModelVol(j) = Svol(a, b, R, V, F, MktStrike(j), T)
sqdError(j) = (ModelVol(j) - MktVol(j)) ^ 2
Next j
EstimateAllParameters = Sum(sqdError)
End Function
MktStrike has the following values in cells E5:E8
12
13
14
15
and MktVol has the following values in cells F5:F8
0.234
0.236
0.242
0.249
Obvious issue is J hasn't been Dim'd
I would change:
Dim R As Double, a As Double, V As Double, N As Integer
To
Dim R As Double, a As Double, V As Double, N As Integer, J as Integer