Related
Its an assignment for a high school class, and I've tried so many things and looked up a lot of things, and just can't get it! The assignment is to make a magic word, whatever the user wants it to be. It's confusing but I want to learn! Any suggestions would be great! I have tried what is in the code below, but I don't know how to specify to add it to the beginning of a label, the assignment is to have a label, and have buttons that are able to add a character in a textbox to the beginning, middle, and end of a label. This is due wednesday 10/20, so please if you know anything about visual basic your help would be greatfully appreciated. thanks!
Here is what I have tried! It only adds a character of a string once to the label, but not again, this is the only code I tried to add to the beginning but have not yet tried to add to the middle and end.
Dim MagicLetter As String
Dim NewString As String
Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged
MagicLetter = TextBox1.Text
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
NewString = Len(Label2.Text)
NewString = Mid(MagicLetter, 1, 0)
NewString = MagicLetter.Insert(1, 0)
If MagicLetter = TextBox1.Text Then
NewString = Mid(MagicLetter, 1, 1)
End If
Label3.Text = "Magic Word: " & MagicLetter
NewString = MagicLetter & Label2.Text
The problem lies here
NewString = Len(Label2.Text)
NewString = Mid(MagicLetter, 1, 0)
NewString = MagicLetter.Insert(1, 0)
What you do here is you write 3 times into the same variable NewString so in the end only the last value NewString = MagicLetter.Insert(1, 0) is in the variable because the 2 before got overwritten by the next one. So these three lines still do the same if you delete the first 2.
Then you don't need any global variables:
Dim MagicLetter As String
Dim NewString As String
You can do it with local variables inside the Button1_Click procedure. Always use local variables over global ones if you can.
Also you don't need the TextBox1_TextChanged event because you are not interested in every change of this text box. You only want to know its content when you click the button.
So we can do everything in the Button1_Click procedure
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim OriginalText As String
OriginalText = Label3.Text ' here we get the text from the label
Dim MagicLetter As String
MagicLetter = TextBox1.Text ' here we get the magic letter from the textbox
Dim NewText As String
NewText = OriginalText ' our new text should be created from the original text
' now we add the magic letter infront
NewText = MagicLetter & NewText
' now we add the magic letter in the end
NewText = NewText & MagicLetter
' now we add the magic letter in the middle
Dim TextLength As Long
TextLength = Len(NewText) ' here we get the length of our text (we need to split it in the middle)
Dim LeftPart As String
LeftPart = Mid(NewText, 1, CLng(TextLength / 2)) ' here we get the left part of the text
Dim RightPart As String
RightPart = Mid(NewText, Len(LeftPart) + 1) ' here we get the right part of the text
' now we add the magic letter between the left and right part
NewText = LeftPart & MagicLetter & RightPart
' finall we write the new text into our label
Label3.Text = NewText
End Sub
Public Class FormMagicWord
Private Function GenerateMagicWord(MagicLetter As Char, Type As String)
'Declare the MagicWord as the label, which is set as just "Magic" in the designer
Dim MagicWord As String = LblMagicWord.Text
'Use a case statement (which is just a cleaner if/else if/else)
Select Case Type
Case "Beginning"
'Combine the MagicLetter and the MagicWord into the MagicWord string.
MagicWord = MagicLetter & MagicWord
Case "Middle"
'Set the initial "midpoint" as 0 in-case the label is empty.
Dim MidPoint As Integer = 0
'Get the middle of the MagicWord string if its length > 0. I used Math.Floor() which will round down to the nearest whole number, so if the length was 9: 9/2 = 4.5 it would round down to 4.
'Alternatively you can use Math.Ceiling() which does the opposite, it rounds up to the next whole number, so if the length was 9: 9/2 = 4.5 it would round up to 5.
'It's cast as an integer (CInt) because we only care about whole numbers for this
If MagicWord.Length > 0 Then
MidPoint = CInt(Math.Floor(MagicWord.Length / 2))
End If
'Insert the MagicLetter at the midpoint of the MagicWord string.
MagicWord = MagicWord.Insert(MidPoint, MagicLetter)
Case "End"
'Combine the MagicWord and the MagicLetter into the MagicWord string.
MagicWord = MagicWord & MagicLetter
Case Else
'Not used, but this would be the "else" equivalent for a Select/Case/Switch statement
End Select
'Return the MagicWord string
Return MagicWord
End Function
'I've changed the handler to manage all three buttons: (BtnBeginning, BtnMiddle, BtnEnd) because the logic is the same for all of them.
'I've also changed the default sender object to Btn as a button, so it explicitly knows what type of control we're handling
Private Sub BtnBeginning_Click(Btn As Button, e As EventArgs) Handles BtnBeginning.Click, BtnMiddle.Click, BtnEnd.Click
'Get the magic letter as a single character, which is all we need.
'The designer also has the max length of the TxtMagicLetter textbox set to 1
Dim MagicLetter As Char = TxtMagicLetter.Text
'Call the GenerateMagicWord function passing the arguments of the letter and the text of the button (Beginning, Middle, End) which will run through the select statement to determine how to format the string
Dim MagicWord As String = GenerateMagicWord(MagicLetter, Btn.Text)
'Finally, set the MagicWord label as the returned string
LblMagicWord.Text = MagicWord
End Sub
End Class
Here's the designer code as well so you can just copy/paste the buttons/textbox/labels.
Here's how to access the code behind the design:
View Designer Code in Visual Studio 2010
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class FormMagicWord
Inherits System.Windows.Forms.Form
'Form overrides dispose to clean up the component list.
<System.Diagnostics.DebuggerNonUserCode()> _
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent()
Me.TxtMagicLetter = New System.Windows.Forms.TextBox()
Me.BtnBeginning = New System.Windows.Forms.Button()
Me.BtnMiddle = New System.Windows.Forms.Button()
Me.BtnEnd = New System.Windows.Forms.Button()
Me.LbLMagicLetter = New System.Windows.Forms.Label()
Me.LblMagicWordLabel = New System.Windows.Forms.Label()
Me.LblMagicWord = New System.Windows.Forms.Label()
Me.SuspendLayout()
'
'TxtMagicLetter
'
Me.TxtMagicLetter.Location = New System.Drawing.Point(249, 12)
Me.TxtMagicLetter.MaxLength = 1
Me.TxtMagicLetter.Name = "TxtMagicLetter"
Me.TxtMagicLetter.Size = New System.Drawing.Size(246, 20)
Me.TxtMagicLetter.TabIndex = 0
'
'BtnBeginning
'
Me.BtnBeginning.Location = New System.Drawing.Point(12, 38)
Me.BtnBeginning.Name = "BtnBeginning"
Me.BtnBeginning.Size = New System.Drawing.Size(157, 33)
Me.BtnBeginning.TabIndex = 1
Me.BtnBeginning.Text = "Beginning"
Me.BtnBeginning.UseVisualStyleBackColor = True
'
'BtnMiddle
'
Me.BtnMiddle.Location = New System.Drawing.Point(175, 38)
Me.BtnMiddle.Name = "BtnMiddle"
Me.BtnMiddle.Size = New System.Drawing.Size(157, 33)
Me.BtnMiddle.TabIndex = 2
Me.BtnMiddle.Text = "Middle"
Me.BtnMiddle.UseVisualStyleBackColor = True
'
'BtnEnd
'
Me.BtnEnd.Location = New System.Drawing.Point(338, 38)
Me.BtnEnd.Name = "BtnEnd"
Me.BtnEnd.Size = New System.Drawing.Size(157, 33)
Me.BtnEnd.TabIndex = 3
Me.BtnEnd.Text = "End"
Me.BtnEnd.UseVisualStyleBackColor = True
'
'LbLMagicLetter
'
Me.LbLMagicLetter.AutoSize = True
Me.LbLMagicLetter.Location = New System.Drawing.Point(172, 12)
Me.LbLMagicLetter.Name = "LbLMagicLetter"
Me.LbLMagicLetter.Size = New System.Drawing.Size(66, 13)
Me.LbLMagicLetter.TabIndex = 4
Me.LbLMagicLetter.Text = "Magic Letter"
'
'LblMagicWordLabel
'
Me.LblMagicWordLabel.AutoSize = True
Me.LblMagicWordLabel.Font = New System.Drawing.Font("Microsoft Sans Serif", 14.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.LblMagicWordLabel.Location = New System.Drawing.Point(8, 141)
Me.LblMagicWordLabel.Name = "LblMagicWordLabel"
Me.LblMagicWordLabel.Size = New System.Drawing.Size(112, 24)
Me.LblMagicWordLabel.TabIndex = 5
Me.LblMagicWordLabel.Text = "Magic Word"
'
'LblMagicWord
'
Me.LblMagicWord.AutoSize = True
Me.LblMagicWord.Font = New System.Drawing.Font("Microsoft Sans Serif", 14.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.LblMagicWord.Location = New System.Drawing.Point(135, 141)
Me.LblMagicWord.Name = "LblMagicWord"
Me.LblMagicWord.Size = New System.Drawing.Size(0, 24)
Me.LblMagicWord.TabIndex = 6
Me.LblMagicWord.Text = "Magic"
'
'FormMagicWord
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(800, 450)
Me.Controls.Add(Me.LblMagicWord)
Me.Controls.Add(Me.LblMagicWordLabel)
Me.Controls.Add(Me.LbLMagicLetter)
Me.Controls.Add(Me.BtnEnd)
Me.Controls.Add(Me.BtnMiddle)
Me.Controls.Add(Me.BtnBeginning)
Me.Controls.Add(Me.TxtMagicLetter)
Me.Name = "FormMagicWord"
Me.Text = "Magic Word"
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Friend WithEvents TxtMagicLetter As TextBox
Friend WithEvents BtnBeginning As Button
Friend WithEvents BtnMiddle As Button
Friend WithEvents BtnEnd As Button
Friend WithEvents LbLMagicLetter As Label
Friend WithEvents LblMagicWordLabel As Label
Friend WithEvents LblMagicWord As Label
End Class
Dim magicWord As String = "abcdef"
Label1.Text = $"{TextBox1.Text}{String.Concat(magicWord.Take(magicWord.Length \ 2))}{TextBox1.Text}{String.Concat(magicWord.Skip(magicWord.Length \ 2))}{TextBox1.Text}"
1abc1def1
When magicWord = "abcdefg" (odd number of characters),
1abc1defg1
the inserted string is not quite in the middle, but the requirement is not clear in your question.
This doesn't include validation such as TextBox.Text should be a char, and magic word length being odd or even. Integer division \ is used to pass an integral number of characters to Take and Skip.
This may not be usable since it doesn't utilize Mid or Len, but I posted it for posterity
NewString = Len(Label2.Text)
You have a problem here Len(String) returns an Integer and you have already declared NewString As String.
NewString = Mid(MagicLetter, 1, 0)
On the very next line, you throw away the value of NewString and assign something else. This is a bit silly because Mid(string, StartIndex, Length) Since the length is 0 this gets you and empty string. Another way this is confusing is the second parameter, 1. In .net indexes for things start at 0 but this "index" starts with 1. Let's just move away from old vb6 methods and use the .net improvements.
NewString = MagicLetter.Insert(1, 0)
Again another assignment. NewString is getting tired. A funny thing about String in .net is that it is immutable (not able to be changed). Under the hood the compiler throws out the old string and creates an entirely new one everytime a string changes. Another problem with this line is the second parameter of Insert takes String. 0 is not a String, it is an Integer.
The backward slash indicate Integer Division.
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim MagicLetter As String = TextBox1.Text
Dim MagicWord = "antiestablishmentarianism"
Label1.Text = MagicWord & MagicLetter
Label2.Text = MagicLetter & MagicWord
Dim WordMiddle = MagicWord.Length \ 2
Label3.Text = MagicWord.Insert(WordMiddle, MagicLetter)
End Sub
I need to find numbers from a string. How does one find numbers from a string in VBA Excel?
Assuming you mean you want the non-numbers stripped out, you should be able to use something like:
Function onlyDigits(s As String) As String
' Variables needed (remember to use "option explicit"). '
Dim retval As String ' This is the return string. '
Dim i As Integer ' Counter for character position. '
' Initialise return string to empty '
retval = ""
' For every character in input string, copy digits to '
' return string. '
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
retval = retval + Mid(s, i, 1)
End If
Next
' Then return the return string. '
onlyDigits = retval
End Function
Calling this with:
Dim myStr as String
myStr = onlyDigits ("3d1fgd4g1dg5d9gdg")
MsgBox (myStr)
will give you a dialog box containing:
314159
and those first two lines show how you can store it into an arbitrary string variable, to do with as you wish.
Regular expressions are built to parse. While the syntax can take a while to pick up on this approach is very efficient, and is very flexible for handling more complex string extractions/replacements
Sub Tester()
MsgBox CleanString("3d1fgd4g1dg5d9gdg")
End Sub
Function CleanString(strIn As String) As String
Dim objRegex
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "[^\d]+"
CleanString = .Replace(strIn, vbNullString)
End With
End Function
Expanding on brettdj's answer, in order to parse disjoint embedded digits into separate numbers:
Sub TestNumList()
Dim NumList As Variant 'Array
NumList = GetNums("34d1fgd43g1 dg5d999gdg2076")
Dim i As Integer
For i = LBound(NumList) To UBound(NumList)
MsgBox i + 1 & ": " & NumList(i)
Next i
End Sub
Function GetNums(ByVal strIn As String) As Variant 'Array of numeric strings
Dim RegExpObj As Object
Dim NumStr As String
Set RegExpObj = CreateObject("vbscript.regexp")
With RegExpObj
.Global = True
.Pattern = "[^\d]+"
NumStr = .Replace(strIn, " ")
End With
GetNums = Split(Trim(NumStr), " ")
End Function
Use the built-in VBA function Val, if the numbers are at the front end of the string:
Dim str as String
Dim lng as Long
str = "1 149 xyz"
lng = Val(str)
lng = 1149
Val Function, on MSDN
I was looking for the answer of the same question but for a while I found my own solution and I wanted to share it for other people who will need those codes in the future. Here is another solution without function.
Dim control As Boolean
Dim controlval As String
Dim resultval As String
Dim i as Integer
controlval = "A1B2C3D4"
For i = 1 To Len(controlval)
control = IsNumeric(Mid(controlval, i, 1))
If control = True Then resultval = resultval & Mid(controlval, i, 1)
Next i
resultval = 1234
This a variant of brettdj's & pstraton post.
This will return a true Value and not give you the #NUM! error. And \D is shorthand for anything but digits. The rest is much like the others only with this minor fix.
Function StripChar(Txt As String) As Variant
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\D"
StripChar = Val(.Replace(Txt, " "))
End With
End Function
This is based on another answer, but is just reformated:
Assuming you mean you want the non-numbers stripped out, you should be able to use something like:
'
' Skips all characters in the input string except digits
'
Function GetDigits(ByVal s As String) As String
Dim char As String
Dim i As Integer
GetDigits = ""
For i = 1 To Len(s)
char = Mid(s, i, 1)
If char >= "0" And char <= "9" Then
GetDigits = GetDigits + char
End If
Next i
End Function
Calling this with:
Dim myStr as String
myStr = GetDigits("3d1fgd4g1dg5d9gdg")
Call MsgBox(myStr)
will give you a dialog box containing:
314159
and those first two lines show how you can store it into an arbitrary string variable, to do with as you wish.
Alternative via Byte Array
If you assign a string to a Byte array you typically get the number equivalents of each character in pairs of the array elements. Use a loop for numeric check via the Like operator and return the joined array as string:
Function Nums(s$)
Dim by() As Byte, i&, ii&
by = s: ReDim tmp(UBound(by)) ' assign string to byte array; prepare temp array
For i = 0 To UBound(by) - 1 Step 2 ' check num value in byte array (0, 2, 4 ... n-1)
If Chr(by(i)) Like "#" Then tmp(ii) = Chr(by(i)): ii = ii + 1
Next i
Nums = Trim(Join(tmp, vbNullString)) ' return string with numbers only
End Function
Example call
Sub testByteApproach()
Dim s$: s = "a12bx99y /\:3,14159" ' [1] define original string
Debug.Print s & " => " & Nums(s) ' [2] display original string and result
End Sub
would display the original string and the result string in the immediate window:
a12bx99y /\:3,14159 => 1299314159
Based on #brettdj's answer using a VBScript regex ojbect with two modifications:
The function handles variants and returns a variant. That is, to take care of a null case; and
Uses explicit object creation, with a reference to the "Microsoft VBScript Regular Expressions 5.5" library
Function GetDigitsInVariant(inputVariant As Variant) As Variant
' Returns:
' Only the digits found in a varaint.
' Examples:
' GetDigitsInVariant(Null) => Null
' GetDigitsInVariant("") => ""
' GetDigitsInVariant(2021-/05-May/-18, Tue) => 20210518
' GetDigitsInVariant(2021-05-18) => 20210518
' Notes:
' If the inputVariant is null, null will be returned.
' If the inputVariant is "", "" will be returned.
' Usage:
' VBA IDE Menu > Tools > References ...
' > "Microsoft VBScript Regular Expressions 5.5" > [OK]
' With an explicit object reference to RegExp we can get intellisense
' and review the object heirarchy with the object browser
' (VBA IDE Menu > View > Object Browser).
Dim regex As VBScript_RegExp_55.RegExp
Set regex = New VBScript_RegExp_55.RegExp
Dim result As Variant
result = Null
If IsNull(inputVariant) Then
result = Null
Else
With regex
.Global = True
.Pattern = "[^\d]+"
result = .Replace(inputVariant, vbNullString)
End With
End If
GetDigitsInVariant = result
End Function
Testing:
Private Sub TestGetDigitsInVariant()
Dim dateVariants As Variant
dateVariants = Array(Null, "", "2021-/05-May/-18, Tue", _
"2021-05-18", "18/05/2021", "3434 ..,sdf,sfd 444")
Dim dateVariant As Variant
For Each dateVariant In dateVariants
Debug.Print dateVariant & ": ", , GetDigitsInVariant(dateVariant)
Next dateVariant
Debug.Print
End Sub
Public Function ExtractChars(strRef$) As String
'Extract characters from a string according to a range of charactors e.g'+.-1234567890'
Dim strA$, e%, strExt$, strCnd$: strExt = "": strCnd = "+.-1234567890"
For e = 1 To Len(strRef): strA = Mid(strRef, e, 1)
If InStr(1, strCnd, strA) > 0 Then strExt = strExt & strA
Next e: ExtractChars = strExt
End Function
In the immediate debug dialog:
? ExtractChars("a-5d31.78K")
-531.78
I have strings (they are actually part numbers) in text files that have not been entered correctly (in full). I need to split and then concatenate them to represent the full part number.
For example:
String ZVN-798-100A/B/C should have been entered as:
ZVN-798-100A
ZVN-798-100B
ZVN-798-100C
String XPD-279-100 to 103 should have been entered as:
XPD-279-100
XPD-279-101
XPD-279-102
XPD-279-103
My code splits these correctly:
AA-10-100A/B/C
BB-20-100A to C
DD-40-100 / 110 / 120
EE-50-100A~H
But not these:
CC-30-100 thru 105
FF-60-110 to 15
For simplicity of posting to SO I have created a single sub of my code:
Private Sub btnRun_Click(sender As System.Object, e As System.EventArgs) Handles btnRun.Click
Dim arrSplitEach(2) As String
arrSplitEach(0) = "\"
arrSplitEach(1) = "/"
arrSplitEach(2) = ","
Dim arrSplitAll(2) As String
arrSplitAll(0) = " to "
arrSplitAll(1) = " thru "
arrSplitAll(2) = "~"
Dim strFromFile(5) As String
strFromFile(0) = "AA-10-100A/B/C"
strFromFile(1) = "BB-20-100A to C"
strFromFile(2) = "CC-30-100 thru 15"
strFromFile(3) = "DD-40-100 / 110 / 120"
strFromFile(4) = "EE-50-100A~H"
strFromFile(5) = "FF-60-100 to 115"
Dim arrOutput As New ArrayList
Dim iSplitEach As Integer
Dim iSplitAll As Integer
Dim strSplitter As String
rtbOutput.Clear()
rtbOutput.Update()
For iString As Integer = LBound(strFromFile) To UBound(strFromFile)
Dim s As String = strFromFile(iString).ToString.Trim
If s <> "" Then
For iSplitEach = LBound(arrSplitEach) To UBound(arrSplitEach)
strSplitter = arrSplitEach(iSplitEach).ToString
If s.Contains(strSplitter) Then
Dim parts As Array = Replace(s, " ", "").Split(strSplitter)
Dim derived As New List(Of String)
derived.Add(parts(0))
Dim intLoopParts As Integer
For intLoopParts = 1 To parts.Length - 1
If Not Len(parts(intLoopParts)) = 0 And Not parts(0).Length < Len(parts(intLoopParts)) Then
derived.Add(parts(0).Remove(parts(0).Length - Len(parts(intLoopParts))) & parts(intLoopParts))
End If
Next
For Each strPart As String In derived
'If strNotVerifiedSplit.Contains(strPart.ToLower.Trim) = False Then
If Not arrOutput.Contains(strPart.Trim) Then
arrOutput.Add(Replace(strPart.Trim, " ", ""))
strFromFile(iString).Equals(strFromFile(iString) & " | Split")
End If
Next
derived.Clear()
End If
Next iSplitEach
For iSplitAll = LBound(arrSplitAll) To UBound(arrSplitAll)
strSplitter = arrSplitAll(iSplitAll).ToString
If s.Contains(strSplitter) Then
Dim strMain As String = Replace(Strings.Left(s, InStr(s, strSplitter) - 1), " ", "")
Dim strStart As String = Mid(s, InStr(s, strSplitter) - 1, 1)
Dim strEnd As String = Strings.Right(s, 1)
Dim strToPlace As String
For Each c As Char In "ABCDEFGHIJKLMNOPQRSTUVWXYZ".ToCharArray()
strToPlace = Strings.Left(strMain, Len(strMain) - 1) & c
If Not strToPlace = "" Then
If Not arrOutput.Contains(strToPlace.Trim) Then
arrOutput.Add(Replace(strToPlace, " ", ""))
strFromFile(iString).Equals(strFromFile(iString) & " | Split")
End If
End If
If c = strEnd Then
Exit For
End If
Next c
End If
Next iSplitAll
End If
s = ""
Next iString
For iOutput As Integer = 0 To arrOutput.Count - 1
rtbOutput.SelectionStart = rtbOutput.TextLength
rtbOutput.SelectionLength = 0
If Not arrOutput(iOutput) = "" Then
rtbOutput.AppendText(arrOutput(iOutput).Trim & vbCrLf)
End If
Next
End Sub
I have found many articles about splitting strings, but do not see a duplicate to this specific case.
It seems like overkill to have to add another chunk of code just to deal with the number ranges and I hope someone can offer some wise advice to improve my existing code.
I would do it like this and avoid the VB6 code style:
Private fList() As String = {"\", "/", ","}
Private fRange() As String = {" to ", " thru ", "~"}
Private Const Letters As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Private Function SplitParts(Part As String) As IEnumerable(Of String)
Dim S, Vals() As String
For Each S In fList
Vals = Split(Part, S)
If Vals.Length > 1 Then Return FixList(Vals)
Next
For Each S In fRange
Vals = Split(Part, S)
If Vals.Length > 1 Then Return FixRange(Vals)
Next
Return {Part}
End Function
Private Function FixList(Vals() As String) As List(Of String)
Dim Ret As New List(Of String), First, Suffix As String
First = Vals.First.Trim
Ret.Add(First)
For i As Integer = 1 To Vals.Length - 1
Suffix = Vals(i).Trim
Ret.Add(First.Substring(0, First.Length - Suffix.Length) & Suffix)
Next
Return Ret
End Function
Private Function FixRange(Vals() As String) As IEnumerable(Of String)
Dim Range As New List(Of String), First, Last, Format As String, i, iMin, iMax As Integer
First = Vals.First.Trim : Last = Vals.Last.Trim
If Integer.TryParse(Last, iMax) AndAlso Integer.TryParse(First.Substring(First.Length - Last.Length), iMin) Then
Format = New String("0"c, Last.Length)
For i = iMin To iMax
Range.Add(i.ToString(Format))
Next
ElseIf Last.Length = 1 Then
iMin = Letters.IndexOf(First.Last) : iMax = Letters.IndexOf(Last)
If iMin >= 0 AndAlso iMax >= 0 Then
For i = iMin To iMax
Range.Add(Letters(i))
Next
End If
End If
First = First.Substring(0, First.Length - Vals.Last.Trim.Length) 'Prefix
Return Range.Select(Function(X) First & X)
End Function
I want to divide one textfile in 5 total chunks. So that I can use one thread on one chunk and so on. i wrote a code in vb.net but if total lines in textfile is multiple of 5 then only my code cover full textfile lines. Please guide me in this.
Private Function breakTextFile(ByVal path As String)
Dim allLines As String() = File.ReadAllLines(path)
Dim sizeOfFile As Integer = allLines.Length
Dim break As Integer = 5, counter As Integer = 0, startline As Integer = 0
Dim index As Integer = sizeOfFile / break
Dim endline As Integer = 0
endline = index
Dim listOfStringArray As New List(Of ArrayList)
Do While (counter <= break)
Dim chunk As New ArrayList
For i = startline To (endline - 1)
Chunk.Add(allLines(i))
Next
listOfStringArray.Add(chunk)
startline = endline
endline = startline + index
counter = counter + 1
Loop
Return listOfStringArray
End Function
Imports MoreLinq
Private Function breakTextFile(ByVal path As String)
Dim listOfStringArray As New List(Of IEnumerable(Of String))
listOfStringArray = File.ReadLines(textFilePath).Batch(10000).ToList()
Return listOfStringArray
End Function
I need to find numbers from a string. How does one find numbers from a string in VBA Excel?
Assuming you mean you want the non-numbers stripped out, you should be able to use something like:
Function onlyDigits(s As String) As String
' Variables needed (remember to use "option explicit"). '
Dim retval As String ' This is the return string. '
Dim i As Integer ' Counter for character position. '
' Initialise return string to empty '
retval = ""
' For every character in input string, copy digits to '
' return string. '
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
retval = retval + Mid(s, i, 1)
End If
Next
' Then return the return string. '
onlyDigits = retval
End Function
Calling this with:
Dim myStr as String
myStr = onlyDigits ("3d1fgd4g1dg5d9gdg")
MsgBox (myStr)
will give you a dialog box containing:
314159
and those first two lines show how you can store it into an arbitrary string variable, to do with as you wish.
Regular expressions are built to parse. While the syntax can take a while to pick up on this approach is very efficient, and is very flexible for handling more complex string extractions/replacements
Sub Tester()
MsgBox CleanString("3d1fgd4g1dg5d9gdg")
End Sub
Function CleanString(strIn As String) As String
Dim objRegex
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "[^\d]+"
CleanString = .Replace(strIn, vbNullString)
End With
End Function
Expanding on brettdj's answer, in order to parse disjoint embedded digits into separate numbers:
Sub TestNumList()
Dim NumList As Variant 'Array
NumList = GetNums("34d1fgd43g1 dg5d999gdg2076")
Dim i As Integer
For i = LBound(NumList) To UBound(NumList)
MsgBox i + 1 & ": " & NumList(i)
Next i
End Sub
Function GetNums(ByVal strIn As String) As Variant 'Array of numeric strings
Dim RegExpObj As Object
Dim NumStr As String
Set RegExpObj = CreateObject("vbscript.regexp")
With RegExpObj
.Global = True
.Pattern = "[^\d]+"
NumStr = .Replace(strIn, " ")
End With
GetNums = Split(Trim(NumStr), " ")
End Function
Use the built-in VBA function Val, if the numbers are at the front end of the string:
Dim str as String
Dim lng as Long
str = "1 149 xyz"
lng = Val(str)
lng = 1149
Val Function, on MSDN
I was looking for the answer of the same question but for a while I found my own solution and I wanted to share it for other people who will need those codes in the future. Here is another solution without function.
Dim control As Boolean
Dim controlval As String
Dim resultval As String
Dim i as Integer
controlval = "A1B2C3D4"
For i = 1 To Len(controlval)
control = IsNumeric(Mid(controlval, i, 1))
If control = True Then resultval = resultval & Mid(controlval, i, 1)
Next i
resultval = 1234
This a variant of brettdj's & pstraton post.
This will return a true Value and not give you the #NUM! error. And \D is shorthand for anything but digits. The rest is much like the others only with this minor fix.
Function StripChar(Txt As String) As Variant
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\D"
StripChar = Val(.Replace(Txt, " "))
End With
End Function
This is based on another answer, but is just reformated:
Assuming you mean you want the non-numbers stripped out, you should be able to use something like:
'
' Skips all characters in the input string except digits
'
Function GetDigits(ByVal s As String) As String
Dim char As String
Dim i As Integer
GetDigits = ""
For i = 1 To Len(s)
char = Mid(s, i, 1)
If char >= "0" And char <= "9" Then
GetDigits = GetDigits + char
End If
Next i
End Function
Calling this with:
Dim myStr as String
myStr = GetDigits("3d1fgd4g1dg5d9gdg")
Call MsgBox(myStr)
will give you a dialog box containing:
314159
and those first two lines show how you can store it into an arbitrary string variable, to do with as you wish.
Alternative via Byte Array
If you assign a string to a Byte array you typically get the number equivalents of each character in pairs of the array elements. Use a loop for numeric check via the Like operator and return the joined array as string:
Function Nums(s$)
Dim by() As Byte, i&, ii&
by = s: ReDim tmp(UBound(by)) ' assign string to byte array; prepare temp array
For i = 0 To UBound(by) - 1 Step 2 ' check num value in byte array (0, 2, 4 ... n-1)
If Chr(by(i)) Like "#" Then tmp(ii) = Chr(by(i)): ii = ii + 1
Next i
Nums = Trim(Join(tmp, vbNullString)) ' return string with numbers only
End Function
Example call
Sub testByteApproach()
Dim s$: s = "a12bx99y /\:3,14159" ' [1] define original string
Debug.Print s & " => " & Nums(s) ' [2] display original string and result
End Sub
would display the original string and the result string in the immediate window:
a12bx99y /\:3,14159 => 1299314159
Based on #brettdj's answer using a VBScript regex ojbect with two modifications:
The function handles variants and returns a variant. That is, to take care of a null case; and
Uses explicit object creation, with a reference to the "Microsoft VBScript Regular Expressions 5.5" library
Function GetDigitsInVariant(inputVariant As Variant) As Variant
' Returns:
' Only the digits found in a varaint.
' Examples:
' GetDigitsInVariant(Null) => Null
' GetDigitsInVariant("") => ""
' GetDigitsInVariant(2021-/05-May/-18, Tue) => 20210518
' GetDigitsInVariant(2021-05-18) => 20210518
' Notes:
' If the inputVariant is null, null will be returned.
' If the inputVariant is "", "" will be returned.
' Usage:
' VBA IDE Menu > Tools > References ...
' > "Microsoft VBScript Regular Expressions 5.5" > [OK]
' With an explicit object reference to RegExp we can get intellisense
' and review the object heirarchy with the object browser
' (VBA IDE Menu > View > Object Browser).
Dim regex As VBScript_RegExp_55.RegExp
Set regex = New VBScript_RegExp_55.RegExp
Dim result As Variant
result = Null
If IsNull(inputVariant) Then
result = Null
Else
With regex
.Global = True
.Pattern = "[^\d]+"
result = .Replace(inputVariant, vbNullString)
End With
End If
GetDigitsInVariant = result
End Function
Testing:
Private Sub TestGetDigitsInVariant()
Dim dateVariants As Variant
dateVariants = Array(Null, "", "2021-/05-May/-18, Tue", _
"2021-05-18", "18/05/2021", "3434 ..,sdf,sfd 444")
Dim dateVariant As Variant
For Each dateVariant In dateVariants
Debug.Print dateVariant & ": ", , GetDigitsInVariant(dateVariant)
Next dateVariant
Debug.Print
End Sub
Public Function ExtractChars(strRef$) As String
'Extract characters from a string according to a range of charactors e.g'+.-1234567890'
Dim strA$, e%, strExt$, strCnd$: strExt = "": strCnd = "+.-1234567890"
For e = 1 To Len(strRef): strA = Mid(strRef, e, 1)
If InStr(1, strCnd, strA) > 0 Then strExt = strExt & strA
Next e: ExtractChars = strExt
End Function
In the immediate debug dialog:
? ExtractChars("a-5d31.78K")
-531.78