I have textbox1 and textbox2 which will be the two inputed data, and I want to get the values between them. And the challenge is the ASCW character I and O is not included.
Im using this basis code:
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim tb1 As String = TextBox1.Text
Dim tb2 As String = TextBox2.Text
Dim cb As String = ""
If tb1.Substring(tb1.Length - 1) <> tb2.Substring(tb2.Length - 1) Then
While (tb1 <> tb2)
Dim temp As String = tb1.Substring(0, tb1.Length - 1)
Dim temp1 As Char = tb1(tb1.Length - 1)
If AscW(UCase(temp1)) >= 48 And AscW(UCase(temp1)) < 90 Then
temp1 = ChrW(AscW(UCase(temp1)) + 1)
ElseIf AscW(UCase(temp1)) >= 90 Then
temp1 = ChrW(AscW(UCase(temp1)) - 42)
End If
tb1 = temp & temp1
If tb1 <> tb2 Then
cb += tb1 & " "
End If
End While
MessageBox.Show(cb)
Else
'Do here
MessageBox.Show("none")
End If
End Sub
Basic arrangement: A0 A1 A2 A3 A4 A5 A6 A7 A8 A9 AA AB AC AD AE AF AG AH AJ AK AL AM AN AP AQ AR AS AT AU AV AW AX AY AZ B0 B1 B2 B3 B4 B5 B6 B7 B8 B9 BA...... ETC.
The ASCW character I and O is not included.
Example Scenario:
textbox1 = SF446DNLS
textbox2 = SF446DNNZ
Output:
SF446DNLT SF446DNLU SF446DNLV SF446DNLW SF446DNLX SF446DNLY SF446DNLZ SF446DNM0 SF446DNM1 SF446DNM2 SF446DNM3 SF446DNM4 SF446DNM5 SF446DNM6 SF446DNM7 SF446DNM8 SF446DNM9 SF446DNMA SF446DNMB SF446DNMC SF446DNMD SF446DNME SF446DNMF SF446DNMG SF446DNMH SF446DNMJ SF446DNMK SF446DNML SF446DNMM SF446DNMN SF446DNMP SF446DNMQ SF446DNMR SF446DNMS SF446DNMT SF446DNMU SF446DNMV SF446DNMW SF446DNMX SF446DNMY SF446DNMZ SF446DNN0 SF446DNN1 SF446DNN2 SF446DNN3 SF446DNN4 SF446DNN5 SF446DNN6 SF446DNN7 SF446DNN8 SF446DNN9 SF446DNNA SF446DNNB SF446DNNC SF446DNND SF446DNNE SF446DNNF SF446DNNG SF446DNNH SF446DNNJ SF446DNNK SF446DNNL SF446DNNM SF446DNNN SF446DNNP SF446DNNQ SF446DNNR SF446DNNS SF446DNNT SF446DNNU SF446DNNV SF446DNNW SF446DNNX SF446DNNY SF446DNNZ
Check my other answer on Extract data really slow with a 30MB random data file for searching between two strings using Regex:
If you need to exclude I and O, use ^ (based on code in the above answer):
Dim allData = "nonmatch2_strA_match_strB_nonmatch2"
Dim r = Regex.Match(allData, "strA([^IO]*)strB")
You can further fine tune the expression to accept only numbers + characters, but without I and O using
Character Class Subtraction # MSDN
Related
I have kind of difficult question.
I have a a string like
2021-09-24 00:52:27
2021-09-23 03:46:08
2021-09-22 04:13:03
2021-09-21 04:08:02
2021-09-20 02:13:27
2021-09-19 05:27:38
2021-09-18 03:43:32
2021-09-17 03:23:44
I need to count the timespan of a last week.
The thing the string not always will be the last 7 days
so i made a string to get the last 7 days and compare them and if a line isnat matching the date it will be 00:00:00,
before that i splited the string.
before that i declared X as a number of lines in the string
2021-09-24
2021-09-23
2021-09-22
2021-09-21
2021-09-20
2021-09-19
2021-09-18
2021-09-17
00:52:27
03:46:08
04:13:03
04:08:02
02:13:27
05:27:38
03:43:32
03:23:44
Dim x As String = RichTextBox4.Lines.Count ' The number of lines with date and hours together
Dim a1 As String = Date.Now.ToString("yyyy-MM") ' Creating dates for the last 7 days
Dim a2 As String = Date.Now.ToString("dd")
Dim b1 As String = Date.Now.ToString("yyyy-MM")
Dim b2 As String = Date.Now.ToString("dd") - 1
Dim c1 As String = Date.Now.ToString("yyyy-MM")
Dim c2 As String = Date.Now.ToString("dd") - 2
Dim dd1 As String = Date.Now.ToString("yyyy-MM")
Dim dd2 As String = Date.Now.ToString("dd") - 3
Dim e1 As String = Date.Now.ToString("yyyy-MM")
Dim e2 As String = Date.Now.ToString("dd") - 4
Dim f1 As String = Date.Now.ToString("yyyy-MM")
Dim f2 As String = Date.Now.ToString("dd") - 5
Dim g1 As String = Date.Now.ToString("yyyy-MM")
Dim g2 As String = Date.Now.ToString("dd") - 6
Dim d1 As String = a1 + "-" + a2
Dim d2 As String = b1 + "-" + b2
Dim d3 As String = c1 + "-" + c2
Dim d4 As String = dd1 + "-" + dd2
Dim d5 As String = e1 + "-" + e2
Dim d6 As String = f1 + "-" + f2
Dim d7 As String = g1 + "-" + g2
Dim lines11 = RichTextBox4.Lines
Dim modifiedLines11 = New List(Of String)()
For index11 As Integer = 0 To lines11.Length - 1
Dim url11 = lines11(index11).Substring(lines11(index11).LastIndexOf(" "c))
modifiedLines11.Insert(index11, lines11(index11).Replace(url11, String.Empty))
modifiedLines11.Add(url11)
RichTextBox4.Text = String.Join(Environment.NewLine, modifiedLines11)
Next
' after split to 2 lists in string
Dim o1 As String = RichTextBox4.Lines(0) ' The first lines of the string is the dates
Dim o2 As String = RichTextBox4.Lines(1)
Dim o3 As String = RichTextBox4.Lines(2)
Dim o4 As String = RichTextBox4.Lines(3)
Dim o5 As String = RichTextBox4.Lines(4)
Dim o6 As String = RichTextBox4.Lines(5)
Dim o7 As String = RichTextBox4.Lines(6)
Dim l1 As String ' This is the second list in the string those are the times
Dim l2 As String
Dim l3 As String
Dim l4 As String
Dim l5 As String
Dim l6 As String
Dim l7 As String
here im trying to compare it to the actual date and if isnt it will give me 00:00:00.
If o1 = d1 Then
l1 = RichTextBox4.Lines(x)
Else
l1 = "00:00:00"
If o2 = d2 Then
l2 = RichTextBox4.Lines(x + 1)
Else
l2 = "00:00:00"
If o3 = d3 Then
l3 = RichTextBox4.Lines(x + 2)
Else
l3 = "00:00:00"
If o4 = d4 Then
l4 = RichTextBox4.Lines(x + 3)
Else
l4 = "00:00:00"
If o5 = o5 Then
l5 = RichTextBox4.Lines(x + 4)
Else
l5 = "00:00:00"
If o6 = d6 Then
l6 = RichTextBox4.Lines(x + 5)
Else
l6 = "00:00:00"
If o7 = d7 Then
l7 = RichTextBox4.Lines(x + 6)
Else
l7 = "00:00:00"
End If
End If
End If
End If
End If
End If
End If
' here im trying to calculate the time.
Dim ts1 As TimeSpan = TimeSpan.Parse(l1)
Dim ts2 As TimeSpan = TimeSpan.Parse(l2)
Dim ts3 As TimeSpan = TimeSpan.Parse(l3)
Dim ts4 As TimeSpan = TimeSpan.Parse(l4)
Dim ts5 As TimeSpan = TimeSpan.Parse(l5)
Dim ts6 As TimeSpan = TimeSpan.Parse(l6)
Dim ts7 As TimeSpan = TimeSpan.Parse(l7)
Dim ttsum As TimeSpan = ts1 + ts2 + ts3 + ts4 + ts5 + ts6 + ts7
MsgBox(ttsum.ToString)
In my opinion the porblem with the code is or the method is bad or the if statements arent good with this method.
Since I don't see any AM/PM data, I am assuming the data in the rich text box is in 24 hour format.
Your code is so complicated because you are manipulate strings instead of dealing with dates. If you want to compare dates and manipulate dates, the first thing you need to do is turn your strings into dates. Since we do not know how many items we are dealing with we will use List(Of T).
Private Function GetListOfDates() As List(Of Date)
Dim lst As New List(Of Date)
Dim provider As CultureInfo = CultureInfo.InvariantCulture
For Each line In RichTextBox1.Lines
' 2021-09-17 03:23:44
lst.Add(Date.ParseExact(line, "yyyy-MM-dd hh:mm:ss", provider))
Next
Return lst
End Function
Next you need to filter the list for last week. For your purposes, a day starts as 00:00:00 and ends at 23:59:59
Private Function FilterListForLastWeek(lst As List(Of Date)) As List(Of Date)
Dim DatesInWeek As New List(Of Date)
'I hardcoded the following date to work with your sample data
Dim LastDayOfWeek = New Date(2021, 9, 24, 23, 59, 59)
'You would use the following code in the real version
'Dim LastDayOfWeek = New Date(Date.Now.Year, Date.Now.Month, Date.Now.Day, 23, 59, 59)
Debug.Print(LastDayOfWeek.ToString)
Dim FirstDayOfWeek = LastDayOfWeek.AddDays(-6)
FirstDayOfWeek = New Date(FirstDayOfWeek.Year, FirstDayOfWeek.Month, FirstDayOfWeek.Day, 0, 0, 0)
Debug.Print(FirstDayOfWeek.ToString)
For Each d In lst
If d >= FirstDayOfWeek AndAlso d <= LastDayOfWeek Then
DatesInWeek.Add(d)
End If
Next
Return DatesInWeek
End Function
It looks like you are considering the hour, minute, second portion of the date as a time span. To add TimeSpan you use the Add method. The last date in the data from the rich text box (the 17th) is excluded since it is not in the week (days 18-24 inclusive is 7 days). The message box displays 1:00:24:17 which is 1 day, zero hours, 24 minutes, and 17 seconds. You can also display as TotalHours, TotalMinutes, etc..
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim AllDates = GetListOfDates()
Dim DatesInWeek = FilterListForLastWeek(AllDates)
Dim TimeSpanSum As TimeSpan
For Each d In DatesInWeek
TimeSpanSum = TimeSpanSum.Add(New TimeSpan(d.Hour, d.Minute, d.Second))
Next
MessageBox.Show(TimeSpanSum.ToString)
End Sub
Can someone help with vba to have beep sounds a few times at the end of multiple macros running.
You can obtain a nice effect using the next class code. Firstly, insert a class module, name it clsMusic and paste the next code in it:
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function Beep Lib "kernel32" _
(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
#Else
Private Declare Function Beep Lib "kernel32" _
(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
#End If
Enum Note
Ab7 = 3322.44
G7 = 3135.96
Gb7 = 2959.96
F7 = 2793.83
E7 = 2637.02
Eb7 = 2489.02
D7 = 2349.32
Db7 = 2217.46
c7 = 2093
B7 = 1975.53
Bb7 = 1864.66
A7 = 1760
Ab6 = 1661.22
G6 = 1567.98
Gb6 = 1479.98
F6 = 1396.91
E6 = 1318.51
Eb6 = 1244.51
D6 = 1174.66
Db6 = 1108.73
c6 = 1046.5
B6 = 987.767
Bb6 = 932.328
A6 = 880
Ab5 = 830.609
G5 = 783.991
Gb5 = 739.989
F5 = 698.456
E5 = 659.255
Eb5 = 622.254
D5 = 587.33
Db5 = 554.365
c5 = 523.251
B5 = 493.883
Bb5 = 466.164
A5 = 440
Ab4 = 415.305
G4 = 391.995
Gb4 = 369.994
F4 = 349.228
E4 = 329.628
Eb4 = 311.127
D4 = 293.665
Db4 = 277.183
c4 = 261.626
B4 = 246.942
Bb4 = 233.082
A4 = 220
Ab3 = 207.652
G3 = 195.998
Gb3 = 184.997
F3 = 174.614
E3 = 164.814
Eb3 = 155.563
D3 = 146.832
Db3 = 138.591
c3 = 130.813
B3 = 123.471
Bb3 = 116.541
A3 = 110
Ab2 = 103.826
G2 = 97.9989
Gb2 = 92.4986
F2 = 87.3071
E2 = 82.4069
Eb2 = 77.7817
d2 = 73.4162
Db2 = 69.2957
c2 = 65.4064
B2 = 61.7354
Bb2 = 58.2705
A2 = 55
Ab1 = 51.9131
G1 = 48.9994
Gb1 = 46.2493
f1 = 43.6535
E1 = 41.2034
Eb1 = 38.8909
d1 = 36.7081
Db1 = 34.6478
c1 = 32.7032
B1 = 30.8677
Bb1 = 29.1352
A1 = 27.5
End Enum
Public Sub Play(myNote As Note, mySeconds As Long, Optional times As Integer = 1)
Dim i As Integer
If times >= 1 Then
For i = 1 To times
Beep myNote, (mySeconds * 300)
Next
End If
End Sub
It creates musical notes...
Then, at the end of your code use something like this:
Sub MusicTest()
Dim Muz As New clsMusic
Muz.Play c4, 1
Muz.Play E4, 1
Muz.Play G4, 1
Muz.Play c5, 3
End Sub
I must mention that I am not the father of the code. I have it in my collection of nice codes. I took it from internet some years before and I do not know who posted it to send the credit in that direction...
I want listbox1 item =
aa
ab
ac
ba
bb
bc
ca
cb
cc
And this my code
Dim text As String = "abc"
Dim i As Integer = 0
Do
ListBox1.Items.Add(text.Chars(i))
i += 1
Loop Until (i = text.Length)
Use this, you need 2 loops:
For i as Integer = 0 to 2
For j as Integer = 0 to 2
ListBox1.Items.Add(text.Chars(i) & text.Chars(j))
Next
Next
With the below code I am trying to format cells when certain names appear in a drop down list(cell C4) and format these specific cells in Range G9:N9. But when I run the code it converts all numbers into percents appose to differentiating between the two formatting styles (Percent and General). Can anyone help?
Sub LetsMakeThisWork()
With Worksheets("Geo")
If C4 = V2 Or C4 = x2 Or C4 = AB2 Or C4 = AD2 Or C4 = AG2 Or C4 = AM2 Or C4 = AO2 Or C4 = AQ2 Or C4 = AU2 Or C4 = AW2 Then
ActiveCell.Range("G9:N9").NumberFormat = "0.0%"
Else
ActiveCell.Range("G9:N9").NumberFormat = "General"
End If
End With
End Sub
In context, you intend C4, V2 etc. to be a cell references but VBA is interpreting them as variables. The fact that your code runs at all in that case implies that you are not using Option Explicit, which you really should use in VBA. What seems to be happening is that you are implicitly creating empty variables in the process of testing them for equality. Any two empty variables are equal, hence the first clause of the If statement is always run. Corrected, but not tested, your code should (I think) look like this:
Option Explicit
Sub LetsMakeThisWork()
Dim C4 As Range
With Worksheets("Geo")
Set C4 = .Range("C4")
If C4.Value = .Range("RV2").Value Or C4.Value = .Range("X2").Value Or _
C4.Value = .Range("AB2").Value Or C4.Value = .Range("AD2").Value Or _
C4.Value = .Range("AG2").Value Or C4.Value = .Range("AM2").Value Or _
C4.Value = .Range("AO2").Value Or C4.Value = .Range("AQ2").Value Or _
C4.Value = .Range("AU2").Value Or C4.Value = .Range("AW2").Value Then
.Range("G9:N9").NumberFormat = "0.0%"
Else
.Range("G9:N9").NumberFormat = "General"
End If
End With
End Sub
So my code searches for permutations from a random given String, and checks some .txt dictionary files (which are loaded in arrays) to see the words that can be made with the random given letters. But my code also makes them permute with themselves. For instance if i put "ab" it should make these permutations "ab" and "ba". INstead it makes "aa", "ab", "ba" and "bb". Any ideas? (the given code is for words until length 3)
If TextBox1.Text.Length > 1 Then
For Each c0 As Char In chars
For Each c1 As Char In chars
For i As Integer = 0 To Rank2.Length - 1
test = Rank2(i)
If InStr(Rank2(i), c0 & c1) Then
RankBox2.Items.Add(test)
End If
Next
Next
Next
End If
If TextBox1.Text.Length > 2 Then
For Each c0 As Char In chars
For Each c1 As Char In chars
For Each c2 As Char In chars
For i As Integer = 0 To Rank3.Length - 1
test = Rank3(i)
If InStr(Rank3(i), c0 & c1 & c2) Then
RankBox3.Items.Add(test)
End If
Next
Next
Next
Next
End If
If TextBox1.Text.Length > 3 Then
For Each c0 As Char In chars
For Each c1 As Char In chars
For Each c2 As Char In chars
For Each c3 As Char In chars
For i As Integer = 0 To Rank4.Length - 1
test = Rank4(i)
If InStr(Rank4(i), c0 & c1 & c2 & c3) Then
RankBox4.Items.Add(test)
End If
Next
Next
Next
Next
Next
End If
If the goal is exclude the arrangement of characters that repeat themselves, then you would need to add a check before processing the code inside the for loops.
For example..
If TextBox1.Text.Length > 1 Then
For Each c0 As Char In chars
For Each c1 As Char In chars
If c0 <> c1 Then
For i As Integer = 0 To Rank2.Length - 1
test = Rank2(i)
If InStr(Rank2(i), c0 & c1) Then
RankBox2.Items.Add(test)
End If
Next
End If
Next
Next
End If
Same solution as #RyanRoos, but with indexes. So the compare is with the indexes.
Dim c0 As Char
Dim c1 As Char
If TextBox1.Text.Length > 1 Then
For i = 0 to chars.Length - 1
For j = 0 to chars.Length - 1
If i <> j Then
For k As Integer = 0 To Rank2.Length - 1
test = Rank2(k)
If InStr(Rank2(k), c0 & c1) Then
RankBox2.Items.Add(test)
End If
Next
End If
Next
Next
End If
So if you have ab, it will produce ab and ba
If you have aba, it will produce aab, aba, baa twice each, because the a at first pos has been permuted with a at third pos.