I need to compare phone numbers from a CSV file to phone numbers in an SSMS database in VB6 without using the .Net Library. One may have a number as 555-555-5555 and the other may have the same number as (555) 555-5555 which obviously kicks back as different when strings are compared.
I know I can use for loops and a buffer to pull out only numeric characters like:
Public Function PhoneNumberNumeric(PhoneNumberCSV As String) As String
Dim CharNdx As Integer
Dim buffer As String
For CharNdx = 1 To Len(PhoneNumberCSV) Step 1
If IsNumeric(Mid(PhoneNumberCSV, CharNdx, 1)) Then
buffer = buffer + Mid(PhoneNumberCSV, CharNdx, 1)
End If
Next
PhoneNumberNumeric = buffer
End Function
but this is expensive. Is there a less expensive way to do this?
This should be a bit quicker:
Private Function Clean(ByRef Original As String) As String
Dim I As Long
Dim J As Long
Dim Char As Long
Clean = Space$(10)
For I = 1 To Len(Original)
Char = AscW(Mid$(Original, I, 1))
If 48 <= Char And Char <= 57 Then
J = J + 1
If J > 10 Then Exit For 'Or raise an exception.
Mid$(Clean, J, 1) = ChrW$(Char)
End If
Next
End Function
It avoids string concatenation, ANSI conversions, and VBScript-form "pigeon VB" (use of slow Variant functions).
Related
I'm trying to split a string of 32 numerical characters into a 16 length Array of Byte and each value has to stay numerical
from "70033023311330000000004195081460" to array {&H_70, &H_03, &H_30, &H_23, ..}
I've tried multiple stuff but each time either it's the conversion that's wrong or I can't find the appropriate combination of functions to implement it.
'it splits but per 1 character only instead of two
str.Select(Function(n) Convert.ToByte(n, 10)).ToArray
'I also tried looping but then the leading zero disappears and the output is a string converted to HEX which is also not what I want.
Function ConvertStringToHexBinary(str As String) As Byte()
Dim arr(15) As Byte
Dim k = 0
For i As Integer = 0 To str.Length - 1
arr(k) = str(i) & str(i + 1)
k += 1
i += 1
Next
Return arr
End Function
Anyone got any suggestion what to do?
G3nt_M3caj's use of LINQ might be.. er.. appealing to the LINQ lovers but it's horrifically inefficient. LINQ is a hammer; not everything is a nail.
This one is about 3 times faster than the LINQ version:
Dim str As String = "70033023311330000000004195081460"
Dim byt(str.Length/2) as Byte
For i = 0 to str.Length - 1 Step 2
byt(i/2) = Convert.ToByte(str.Substring(i, 2))
Next i
And this one, which does it all with math and doesn't do any new stringing at all is just under 3 times faster than the above (making it around 9 times faster than the LINQ version):
Dim str As String = "70033023311330000000004195081460"
Dim byt(str.Length / 2) As Byte
For i = 0 To str.Length - 1
If i Mod 2 = 0 Then
byt(i / 2) = (Convert.ToByte(str(i)) - &H30) * &HA
Else
byt(i / 2) += Convert.ToByte(str(i)) - &H30
End If
Next i
Of the two, I prefer the stringy version because it's easier to read and work out what's going on - another advantage loops approaches often have over a LINQ approach
Do you need something like this?
Dim str As String = "70033023311330000000004195081460"
Dim mBytes() As Byte = str.
Select(Function(x, n) New With {x, n}).
GroupBy(Function(x) x.n \ 2, Function(x) x.x).
Select(Function(y) Convert.ToByte(New String(y.ToArray()), 10)).ToArray
I have a 32-bit value that is stored in the VB.Net type Integer (i.e. Int32.) I am only interested in the bits - not the numerical value. Sometimes the 32nd bit is a one which is interpreted as a negative number. My goal is to reverse the actual bits. My original data is encoded into bits right-to-left (LSB right-most) and is read back in left-to-right (MSB left-most.) I am adapting someone else's code and design. One thought I had was maybe to convert to a long temporarily but I don't know how to do that and preserve the 32nd bit correctly.
Public Shared Function ReverseBits32(ByVal n As Integer) As Integer
Dim result As Integer = 0
For i As Integer = 0 To 32 - 1
result = result * 2 + n Mod 2
n = n >> 1 'n Or 2
Next
Return result
End Function
If you had a method to reverse the bits of a byte you could apply it four times to the bytes of an integer. A little research finds Bit Twiddling Hacks.
Module Module1
Sub ShowBits(a As Integer)
Dim aa = BitConverter.GetBytes(a)
Console.WriteLine(String.Join(" ", aa.Select(Function(b) Convert.ToString(b, 2).PadLeft(8, "0"c))))
End Sub
Function ReverseBits(b As Byte) As Byte
' From https://graphics.stanford.edu/~seander/bithacks.html#ReverseByteWith32Bits
Dim c = CULng(b)
Return CByte((((c * &H802UL And &H22110UL) Or (c * &H8020UL And &H88440UL)) * &H10101UL >> 16) And &HFFUL)
End Function
Function ReverseBits(a As Integer) As Integer
Dim bb = BitConverter.GetBytes(a)
Dim cc(3) As Byte
For i = 0 To 3
cc(3 - i) = ReverseBits(bb(i))
Next
Return BitConverter.ToInt32(cc, 0)
End Function
Sub Main()
Dim y = -762334566
ShowBits(y)
y = ReverseBits(y)
ShowBits(y)
Console.ReadLine()
End Sub
End Module
Output from test value:
10011010 10110010 10001111 11010010
01001011 11110001 01001101 01011001
I used the "no 64-bit" method because it is written for a language where arithmetic overflow is ignored - the methods using 64-bit operations rely on that but it is not the default for VB.NET.
How do i get the Index of the last active column in a row using Open Xml
i have this for row 1.
Dim activeCells As IEnumerable(Of DocumentFormat.OpenXml.Spreadsheet.Cell) = row.Descendants(Of DocumentFormat.OpenXml.Spreadsheet.Cell)().Where(Function(c) Not String.IsNullOrEmpty(c.InnerText))
Dim cell As DocumentFormat.OpenXml.Spreadsheet.Cell = activeCells.LastOrDefault()
Dim CellRef As String = cell.CellReference
This gives D1", but what i want is the index in this case "4". how do i go about this?
To convert the cell reference to a column index you could use something like the following (I've converted the code from the answer here which you've inspired me to write :)).
Private Shared Function GetColumnIndex(cellReference As String) As System.Nullable(Of Integer)
If String.IsNullOrEmpty(cellReference) Then
Return Nothing
End If
'remove digits
Dim columnReference As String = Regex.Replace(cellReference.ToUpper(), "[\d]", String.Empty)
Dim columnNumber As Integer = -1
Dim mulitplier As Integer = 1
'working from the end of the letters take the ASCII code less 64 (so A = 1, B =2...etc)
'then multiply that number by our multiplier (which starts at 1)
'multiply our multiplier by 26 as there are 26 letters
For Each c As Char In columnReference.ToCharArray().Reverse()
columnNumber += mulitplier * (CInt(c) - 64)
mulitplier = mulitplier * 26
Next
'the result is zero based so return columnnumber + 1 for a 1 based answer
'this will match Excel's COLUMN function
Return columnNumber + 1
End Function
Note: the VB might not be idiomatic as I used the Telerik Converter to convert it from C# to VB.
Q: Why out of memory when my system have plenty of it left (and office is 64bit)
Q: Could it be that data when split cause such strange behavior?
Q: If splitting that string cause trouble then how to sanititize/restore it for just operations of storing/restoring that string?
Specs: Win 8.1 Pro + Office 2013 64bit, 8GB RAM in system
And here is the code, which just get single LARGE (~1-2MB) string, and split it into multiple cells, so that 32k chars per cell limit do not cause harm:
Public Sub SaveConst(str As String)
Dim i As Long
i = 0
' Clear prior data
Do While LenB(Range("ConstJSON").Offset(0, i)) <> 0
Range("ConstJSON").Offset(0, i) = ""
i = i + 1
Loop
Dim strLen As Long
With Range("ConstJSON")
.Offset(0, 0) = Left$(str, 30000)
i = 1
strLen = Len(str)
Debug.Print strLen
Do While strLen > i * 30000
.Offset(0, i) = Mid$(str, i * 30000 + 1, 30000)
Debug.Print i
i = i + 1
Loop
End With
End Sub
Right now Len(str) report ~270k characters, and i goes up to 4 iteration, and then "Out of memory" bug kick in.
Now that is n-th iteration of that bug in this place. But I have simplified/modified code so that it works sometimes. For exact same data set.
UPDATE:
Thx to Jean code, I'm confident that its SAVING partial string to the cell that cause that error.
.Offset(0, i) = Mid$(str, i * 30000 + 1, 30000)
Or
Range("ConstJSON").Resize(nPieces).Value2 = v
Both cause errors.
UPDATE 2:
I was saving that string to single cell without any fuss. But now that string grew too big to fit, splitting sometimes cause that error "Out of the memory".
Exemplary string:
[...]
""ebiZlecenias"":[{""id"":""91a75940-6d3e-06f8-bcf7-28ecd49e85f2"",""lp"":null,""name"":""ZLECENIE
GŁÓWNE"",""date_entered"":""2014-04-15
08:13:18"",""date_modified"":""2014-04-15
08:13:18"",""modified_user_id"":""2"",""budowa_id"":""8614aab5-29da-ffac-4865-e8c5913c729c"",""rodzaj"":""1"",""etap"":""1"",""data_akceptacji"":null,""opis"":null,""user_id"":null,""data_bazowa_od"":null,""data_bazowa_do"":null,""data_rzeczywista_od"":null,""data_rzeczywista_do"":null,""archiwalny"":null,""deleted"":null,""termin_raportowania"":null,""okres_raportowania"":null,
[...]
EDIT: I believe the problem with your specimen string is that some of the substrings begin with a "-". When that happens, Excel thinks the contents is a formula, and that is what causes the error. Pre-formatting the cell as text did not correct the problem, but preceding each entry with a 'single quote', which coerces the entry to text and will not show up except in the formula bar, seems to have corrected the problem in my macros, even when using your specimen string above as the "base" string.
EDIT2: What seems to be happening is that, if the string length is greater than 8,192 characters (the longest allowed in a formula), and also starts with a token that makes Excel think it might be a formula (e.g: -, +, =), the write to the cell will fail with an out of memory error EVEN IF the cell is formatted as text. This does not happen if the single quote is inserted first.
Below is some code that works on much longer strings.
The code below first creates a long string, in this case the string is slightly more than 100,000,000 characters, and then splits it into sequential columns. No errors:
Option Explicit
Sub MakeLongString()
Dim S As String
Const strLEN As Long = 100 * 10 ^ 6
Const strPAT As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
S = strPAT
Do
S = S & S
Loop Until Len(S) > strLEN
Debug.Print Format(Len(S), "#,###")
SplitString (S)
Debug.Print Range("a1").End(xlToRight).Column
End Sub
Sub SplitString(STR)
Dim R As Range
Dim strLEN As Long
Set R = [a1]
Dim I As Long
strLEN = Len(STR)
Do Until I > strLEN
R(1, I / 30000 + 1) = "'" & Mid(STR, I + 1, 30000)
I = I + 30000
Loop
End Sub
I just ran a test where the range being written to was a multi-cell range, and the target was set by the Offset method as you did, and it also ran to completion without error, filling in the first four rows.
Sub SplitString(STR)
Dim R As Range
Dim strLEN As Long
Set R = [a1:a4]
Dim I As Long
strLEN = Len(STR)
Do Until I > strLEN
R.Offset(, I / 30000) = "'" & Mid(STR, I + 1, 30000)
I = I + 30000
Loop
End Sub
This is worth a try: first split the string into an array, then slap that entire array onto the sheet at once.
Const pieceLength As Long = 3000
Dim s As String
Dim i As Long
Dim nPieces As Long
Dim v As Variant
s = ... ' whatever your string is...
nPieces = WorksheetFunction.Ceiling(Len(s) / pieceLength, 1)
ReDim v(1 To nPieces, 1 To 1)
For i = 1 To nPieces
v(i, 1) = Mid(s, (pieceLength * i) + 1, pieceLength)
Next i
Range("ConstJSON").Resize(nPieces).Value2 = v
I haven't tested your code, so can't say exactly what's wrong with it, but I know that writing to (or reading from) individual cells one at a time is slow and expensive; it's usually much better to read/write large swaths of cells to/from arrays, and manipulate the arrays (instead of the cells).
I have a 2 character string composed only of the 26 capital alphabet letters, 'A' through 'Z'.
We have a way of knowing the "highest" used value (e..g "IJ" in {"AB", "AC", "DD", "IH", "IJ"}). We'd like to get the "next" value ("IK" if "IJ" is the "highest").
Function GetNextValue(input As String) As String
Dim first = input(0)
Dim last = input(1)
If last = "Z"c Then
If first = "Z"c Then Return Nothing
last = "A"c
first++
Else
last++
EndIf
Return first & last
End Function
Obviously char++ is not valid syntax in VB.NET. C# apparently allows you to do this. Is there something shorter less ugly than this that'd increment a letter? (Note: Option Strict is on)
CChar(CInt(char)+1).ToString
Edit: As noted in comment/answers, the above line won't even compile. You can't convert from Char -> Integer at all in VB.NET.
The tidiest so far is simply:
Dim a As Char = "a"
a = Chr(Asc(a) + 1)
This still needs handling for the "z" boundary condition though, depending on what behaviour you require.
Interestingly, converting char++ through developerfusion suggests that char += 1 should work. It doesn't. (VB.Net doesn't appear to implicitly convert from char to int16 as C# does).
To make things really nice you can do the increment in an Extension by passing the char byref. This now includes some validation and also a reset back to a:
<Extension>
Public Sub Inc(ByRef c As Char)
'Remember if input is uppercase for later
Dim isUpper = Char.IsUpper(c)
'Work in lower case for ease
c = Char.ToLower(c)
'Check input range
If c < "a" Or c > "z" Then Throw New ArgumentOutOfRangeException
'Do the increment
c = Chr(Asc(c) + 1)
'Check not left alphabet
If c > "z" Then c = "a"
'Check if input was upper case
If isUpper Then c = Char.ToUpper(c)
End Sub
Then you just need to call:
Dim a As Char = "a"
a.Inc() 'a is now = "b"
My answer will support up to 10 characters, but can easily support more.
Private Sub Test
MsgBox(ConvertBase10ToBase26(ConvertBase26ToBase10("AA") + 1))
End Sub
Public Function ConvertBase10ToBase26(ToConvert As Integer) As String
Dim pos As Integer = 0
ConvertBase10ToBase26 = ""
For pos = 10 To 0 Step -1
If ToConvert >= (26 ^ pos) Then
ConvertBase10ToBase26 += Chr((ToConvert \ (26 ^ pos)) + 64)
ToConvert -= (26 ^ pos)
End If
Next
End Function
Public Function ConvertBase26ToBase10(ToConvert As String) As Integer
Dim pos As Integer = 0
ConvertBase26ToBase10 = 0
For pos = 0 To ToConvert.Length - 1
ConvertBase26ToBase10 += (Asc(ToConvert.Substring(pos, 1)) - 64) * (26 ^ pos)
Next
End Function
Unfortunately, there's no easy way -- even CChar(CInt(char)+1).ToString doesn't work. It's even uglier:
CChar(Char.ConvertFromUtf32(Char.ConvertToUtf32(myCharacter, 0) + 1))
but of course you could always put that in a function with a short name or, like Jon E. pointed out, an extension method.
Try this
Private Function IncBy1(input As String) As String
Static ltrs As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim first As Integer = ltrs.IndexOf(input(0))
Dim last As Integer = ltrs.IndexOf(input(1))
last += 1
If last = ltrs.Length Then
last = 0
first += 1
End If
If first = ltrs.Length Then Return Nothing
Return ltrs(first) & ltrs(last)
End Function
This DOES assume that the code is only two chars, and are A-Z only.
Dim N as String = ""
Dim chArray As Char = Convert.ToChar(N)
Dim a As String = CChar(Char.ConvertFromUtf32(Char.ConvertToUtf32(chArray, 0) + 1))