I have a string say "768932A3" that I want split up into two's like this:
76 89 32 A3 for purposes of conversion to binary. I have tried looping but it doesn't work. Kindly help:
For i = 0 To data.Length - 1
j = i + 2
incremented &= Convert.ToInt64(data.Substring(i, j), 16)
ascii &= Chr(Convert.ToInt64(data.Substring(i, j), 16))
i = j + 2
Next
The second parameter of Substring is not the ending position but the lenght of characters to consider from the starting position.
For i = 0 To data.Length - 1 Step 2
' Not clear what are you trying to do here
' incremented &= Convert.ToInt64(data.Substring(i, 2), 16)
Dim value As Long = Convert.ToInt64(data.Substring(i, 2), 16)
ascii &= Chr(Convert.ToInt64(data.Substring(i, 2), 16))
Next
Related
I'm working on a macro right now and it's producing weird results. The part that is specifically not working is a Min function.
a1RowTemp1 = a1Row
For i = 0 To diff1
intercept = Application.WorksheetFunction.intercept(a(),c())
LinReg1 = (slope * Cells(a1RowTemp1, 1)) + intercept
difference1 = Worksheets("GF9").Cells(a1RowTemp1, 2) - LinReg1
e(i) = difference1
a1RowTemp1 = a1RowTemp1 + 1
Next i
a2RowTemp2 = a2Row
For i = 0 To diff2
intercept2 = Application.WorksheetFunction.intercept(b(), d())
LinReg2 = (slope2 * Cells(a2RowTemp2, 1)) + intercept2
difference2 = Worksheets("GF9").Cells(a2RowTemp2, 2) - LinReg2
f(i) = difference2
a2RowTemp2 = a2RowTemp2 + 1
Next i
Worksheets("Chart").Cells(currentRow, 12) = Application.Max(e())
Worksheets("Chart").Cells(currentRow, 13) = Application.Min(e())
Worksheets("Chart").Cells(currentRow, 25) = Application.Max(f())
Worksheets("Chart").Cells(currentRow, 26) = Application.Min(f())
In the bottom of the code it stores the difference1 and difference2 values in arrays e() and f(). When I use the functions max/min the macro only outputs the correct values for the max functions. I suspect this has something to do with my incorrectly using the arrays.
If e is one dimensional array you should be able to write
Application.WorksheetFunction.Min(e)
Example:
Option Explicit
Public Sub TEST()
Dim e()
e = Array(3, 4, 2, 5)
MsgBox Application.WorksheetFunction.Min(e)
End Sub
If you are still getting the wrong values you need to step though with F8 and check the values being assigned to e in the loop are the expected ones.
You've omitted the declaration and dimensioning of the e and f array. This was an important factor in your problem.
When you declared your e and f as long or double arrays, they were instantiated with zero values.
Dim v() As Double, i As Long
ReDim v(5) '<~~ all zero values
For i = LBound(v) To UBound(v) - 1 '<~~fill all but the last one
v(i) = i + 10
Next i
Debug.Print Application.Min(v) 'zero as v(5) is zero
If you want to ignore array elements that you have not assigned values to, declare the arrays as a variant type.
Dim v() As Variant, i As Long
ReDim v(5) '<~~ all empty values
For i = LBound(v) To UBound(v) - 1 '<~~fill all but the last one
v(i) = i + 10
Next i
Debug.Print Application.Min(v) '10 as v(5) is empty and not considered in Min
An unassigned variant array element is considered empty and is not used in the Min calculation.
Alternately, use one of two methods to remove unused array elements.
'...
'redimension before the loop to the known ubound
redim e(diff1)
For i = 0 To diff1
intercept = Application.WorksheetFunction.intercept(a(),c())
LinReg1 = (slope * Cells(a1RowTemp1, 1)) + intercept
difference1 = Worksheets("GF9").Cells(a1RowTemp1, 2) - LinReg1
e(i) = difference1
a1RowTemp1 = a1RowTemp1 + 1
Next i
'...
'or redimension after the loop with Preserve
For i = 0 To diff2
intercept2 = Application.WorksheetFunction.intercept(b(), d())
LinReg2 = (slope2 * Cells(a2RowTemp2, 1)) + intercept2
difference2 = Worksheets("GF9").Cells(a2RowTemp2, 2) - LinReg2
f(i) = difference2
a2RowTemp2 = a2RowTemp2 + 1
Next i
'i exits with a value 1 greater than diff2
redim preserve f(i-1)
'...
I have a set which has an unknown number of objects. I want to associate a label to each one of these objects. Instead of labeling each object with a number I want to label them with letters.
For example the first object would be labeled A the second B and so on.
When I get to Z, the next object would be labeled AA
AZ? then BA, BB, BC.
ZZ? then AAA, AAB, AAC and so on.
I'm working using Mapbasic (similar to VBA), but I can't seem to wrap my head around a dynamic solution. My solution assumes that there will be a max number of objects that the set may or may not exceed.
label = pos1 & pos2
Once pos2 reaches ASCII "Z" then pos1 will be "A" and pos2 will be "A". However, if there is another object after "ZZ" this will fail.
How do I overcome this static solution?
Basically what I needed was a Base 26 Counter. The function takes a parameter like "A" or "AAA" and determines the next letter in the sequence.
Function IncrementAlpha(ByVal alpha As String) As String
Dim N As Integer
Dim num As Integer
Dim str As String
Do While Len(alpha)
num = num * 26 + (Asc(alpha) - Asc("A") + 1)
alpha = Mid$(alpha, 2,1)
Loop
N = num + 1
Do While N > 0
str = Chr$(Asc("A") + (N - 1) Mod 26) & str
N = (N - 1) \ 26
Loop
IncrementAlpha = str
End Function
If we need to convert numbers to a "letter format" where:
1 = A
26 = Z
27 = AA
702 = ZZ
703 = AAA etc
...and it needs to be in Excel VBA, then we're in luck. Excel's columns are "numbered" the same way!
Function numToLetters(num As Integer) As String
numToLetters = Split(Cells(1, num).Address(, 0), "$")(0)
End Function
Pass this function a number between 1 and 16384 and it will return a string between A and XFD.
Edit:
I guess I misread; you're not using Excel. If you're using VBA you should still be able to do this will the help of an reference to an Excel Object Library.
This should get you going in terms of the logic. Haven't tested it completely, but you should be able to work from here.
Public Function GenerateLabel(ByVal Number As Long) As String
Const TOKENS As String = "ZABCDEFGHIJKLMNOPQRSTUVWXY"
Dim i As Long
Dim j As Long
Dim Prev As String
j = 1
Prev = ""
Do While Number > 0
i = (Number Mod 26) + 1
GenerateLabel = Prev & Mid(TOKENS, i, 1)
Number = Number - 26
If j > 0 Then Prev = Mid(TOKENS, j + 1, 1)
j = j + Abs(Number Mod 26 = 0)
Loop
End Function
I am banging my head against the wall for a while now trying different techniques.
None of them are working well.
I have two strings.
I need to compare them and get an exact percentage of match,
ie. "four score and seven years ago" TO "for scor and sevn yeres ago"
Well, I first started by comparing every word to every word, tracking every hit, and percentage = count \ numOfWords. Nope, didn't take into account misspelled words.
("four" <> "for" even though it is close)
Then I started by trying to compare every char in each char, incrementing the string char if not a match (to count for misspellings). But, I would get false hits because the first string could have every char in the second but not in the exact order of the second. ("stuff avail" <> "stu vail" (but it would come back as such, low percentage, but a hit. 9 \ 11 = 81%))
SO, I then tried comparing PAIRS of chars in each string. If string1[i] = string2[k] AND string1[i+1] = string2[k+1], increment the count, and increment the "k" when it doesn't match (to track mispellings. "for" and "four" should come back with a 75% hit.) That doesn't seem to work either. It is getting closer, but even with an exact match it is only returns 94%. And then it really gets screwed up when something is really misspelled. (Code at the bottom)
Any ideas or directions to go?
Code
count = 0
j = 0
k = 0
While j < strTempName.Length - 2 And k < strTempFile.Length - 2
' To ignore non letters or digits '
If Not strTempName(j).IsLetter(strTempName(j)) Then
j += 1
End If
' To ignore non letters or digits '
If Not strTempFile(k).IsLetter(strTempFile(k)) Then
k += 1
End If
' compare pair of chars '
While (strTempName(j) <> strTempFile(k) And _
strTempName(j + 1) <> strTempFile(k + 1) And _
k < strTempFile.Length - 2)
k += 1
End While
count += 1
j += 1
k += 1
End While
perc = count / (strTempName.Length - 1)
Edit: I have been doing some research and I think I initially found the code from here and translated it to vbnet years ago. It uses the Levenshtein string matching algorithm.
Here is the code I use for that, hope it helps:
Sub Main()
Dim string1 As String = "four score and seven years ago"
Dim string2 As String = "for scor and sevn yeres ago"
Dim similarity As Single =
GetSimilarity(string1, string2)
' RESULT : 0.8
End Sub
Public Function GetSimilarity(string1 As String, string2 As String) As Single
Dim dis As Single = ComputeDistance(string1, string2)
Dim maxLen As Single = string1.Length
If maxLen < string2.Length Then
maxLen = string2.Length
End If
If maxLen = 0.0F Then
Return 1.0F
Else
Return 1.0F - dis / maxLen
End If
End Function
Private Function ComputeDistance(s As String, t As String) As Integer
Dim n As Integer = s.Length
Dim m As Integer = t.Length
Dim distance As Integer(,) = New Integer(n, m) {}
' matrix
Dim cost As Integer = 0
If n = 0 Then
Return m
End If
If m = 0 Then
Return n
End If
'init1
Dim i As Integer = 0
While i <= n
distance(i, 0) = System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
Dim j As Integer = 0
While j <= m
distance(0, j) = System.Math.Max(System.Threading.Interlocked.Increment(j), j - 1)
End While
'find min distance
For i = 1 To n
For j = 1 To m
cost = (If(t.Substring(j - 1, 1) = s.Substring(i - 1, 1), 0, 1))
distance(i, j) = Math.Min(distance(i - 1, j) + 1, Math.Min(distance(i, j - 1) + 1, distance(i - 1, j - 1) + cost))
Next
Next
Return distance(n, m)
End Function
Did not work for me unless one (or both) of following are done:
1) use option compare statement "Option Compare Text" before any Import declarations and before Class definition (i.e. the very, very first line)
2) convert both strings to lowercase using .tolower
Xavier's code must be correct to:
While i <= n
distance(i, 0) = System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
End While
Dim j As Integer = 0
While j <= m
distance(0, j) = System.Math.Min(System.Threading.Interlocked.Increment(j), j - 1)
End While
In VBA, I can easily pull in an sheet\range into an array, manipulate, then pass back to the sheet\range. I'm having trouble doing this in VB.Net though.
Here's my code.
Rng = .Range("a4", .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
Dim SheetArray(,) As Object = DirectCast(Rng.Value(Excel.XlRangeValueDataType.xlRangeValueDefault), Object(,))
For X As Integer = 0 To SheetArray.GetUpperBound(0)
If IsNothing(SheetArray(X, 0)) Then Exit For
SheetArray(X, 6) = SheetArray(X, 3)
SheetArray(X, 7) = CDbl(SheetArray(X, 3).ToString) - CDbl(SheetArray(X, 1).ToString) - _
CDbl(SheetArray(X, 7).ToString)
For Y As Integer = 0 To 3
SheetArray(X, Y * 2 + 1) = Math.Round(CDbl(SheetArray(X, Y * 2 + 1).ToString), 3)
Next
If Math.Abs(CDbl(SheetArray(X, 7).ToString)) > 0.1 Then _
.Range(.Cells(X + 1, 1), .Cells(X + 1, 8)).Font.Color = -16776961
Next
I'm getting an error on the first If IsNothing(SheetArray(X, 0)) Then Exit For
line. It is telling me index is out of bounds of the array. Any idea why? The SheetArray object contains the data, but I just am not sure how to get to it.
In the For you have to loop from 0 to Count - 1:
For X As Integer = 0 To SheetArray.GetUpperBound(0) - 1
'...
Next
That will fix your problem.
This function goes through all integers and picks out binary values with only five ones and writes them to the spreadsheet.
To run this For x = 1 To 134217728 would take 2.5 days!!!! Help!
How could I speed this up?
Function D2B(ByVal n As Long) As String
n = Abs(n)
D2B = ""
Do While n > 0
If n = (n \ 2) * 2 Then
D2B = "0" & D2B
Else
D2B = "1" & D2B
n = n - 1
End If
n = n / 2
Loop
End Function
Sub mixtures()
Dim x As Long
Dim y As Integer
Dim fill As String
Dim mask As String
Dim RowOffset As Integer
Dim t As Date
t = Now
fill = ""
For x = 1 To 134217728
mask = Right(fill & CStr(D2B(x)), Len(fill & CStr(D2B(x))))
Debug.Print mask
If x > 100000 Then Exit For
If Len(mask) - Len(WorksheetFunction.Substitute(mask, "1", "")) = 5 Then _
RowOffset = RowOffset + 1
For y = 1 To Len(mask)
If Len(mask) - Len(WorksheetFunction.Substitute(mask, "1", "")) = 5 Then _
Range("mix").Offset(RowOffset).Cells(y) = Mid(mask, y, 1)
Next
Next
Debug.Print DateDiff("s", Now, t)
End Sub
By first sight guess, I think the problem lies in the fact that you do that cell by cell, which causes many read and write accesses.
You should do it range by range, like
vArr = Range("A1:C1000").Value
' it is array now, do something here effeciently
Range("A1:C1000").Value = vArr
You want find all 28bit numbers with 5 1s
There are 28*27*26*25*24/5/4/3/2=98280 such numbers
The following code took ~10 seconds on my PC:
lineno = 1
For b1 = 0 To 27
For b2 = b1 + 1 To 27
For b3 = b2 + 1 To 27
For b4 = b3 + 1 To 27
For b5 = b4 + 1 To 27
Cells(lineno, 1) = 2 ^ b1 + 2 ^ b2 + 2 ^ b3 + 2 ^ b4 + 2 ^ b5
lineno = lineno + 1
Next
Next
Next
Next
Next
mask = Right(fill & CStr(D2B(x)), Len(fill & CStr(D2B(x))))
The above line of code does the same thing (CStr(D2B(x))) twice.
Store the result of CStr(D2B(x)) in a variable & use that variable in the above line of code.
I've got 2 suggestions:
Get rid of the substitution command by counting the ones/zeroes in D2B and return an empty string if the count does not equal 5
Write these pre-filtered bitstrings to an array first and copy the array directly to the cells when finished.
Something like
ws.Range(ws.cells(1, 1), ws.cells(UBound(dstArr, 1) + 1, UBound(dstArr, 2) + 1)) = dstArr
The array-copy-trick greatly improves performance!