Dim Var_1 As String
Dim Var_2 As String
Dim Var_3 As String
Dim Var_4 As String
Dim Var_5 As String
Dim Var_6 As String
Dim Var_7 As String
Dim Var_8 As String
Dim Var_9 As String
Dim Var_10 As String
Dim Var_11 As String
Dim Var_12 As String
Dim Var_13 As String
Dim Var_14 As String
Dim Var_15 As String
Dim Var_16 As String
Dim Var_17 As String
Dim Var_18 As String
Dim Var_19 As String
Dim Var_20 As String
Dim Var_21 As String
Dim Var_22 As String
Dim Var_23 As String
Dim Var_24 As String
Dim Var_25 As String
Dim Var_26 As String
Dim Var_27 As String
Dim Var_28 As String
Dim Var_29 As String
Var_1 = "Ex-Bidadi"
Var_2 = "Ex-Hospet"
Var_3 = "Ex-Chennai"
Var_4 = "Ex-Coimbatore"
Var_5 = "Ex-Gangaikondan"
Var_6 = "Ex-Pune"
Var_7 = "Ex-Goa"
Var_8 = "Ex-Mumbai"
Var_9 = "Ex-Nashik"
Var_10 = "Ex-Aurangabad"
Var_11 = "Ex-Goblej"
Var_12 = "Ex-Hyderabad"
Var_13 = Ex - Vizag
Var_14 = "Ex-Vijayawada"
Var_15 = "Ex-Chittoor"
Var_16 = "Ex - Siliguri"
Var_17 = "Ex-odhisha"
Var_18 = "Ex-Jharkhand"
Var_19 = "Ex-Bihar"
Var_20 = "Ex-NorthEast"
Var_21 = "Ex-Delhi"
Var_22 = "Ex-Udaipur"
Var_23 = "Ex-Jammu"
Var_24 = "Ex-Haridwar"
Var_25 = "Ex-Dasna"
Var_26 = "Ex-Kanpur"
Var_27 = "Ex-Unnao"
Var_28 = "Ex-Var_anasi"
Var_29 = "Ex-Bhopal"
I am showing you a part of my code and i just want to known how to loop these I tried using this representation
For n = 1 to 29
For i = 3 To 445
For m = 28 To 40
ActiveWorkbook.Sheets("Var_" & n).Cells(i, m) = 999999
least(i, m, n) = ActiveWorkbook.Sheets("Var_" & n).Cells(i, m)
Next m
Next i
Next n
I have defined the least(i,m,n) array but the loop is showing an error at the subscript is out of Range I have tried using all the possibilities but the loop doesn't work
You need to store the sheet names in an array:
Var = Array("Ex-Bidadi", "Ex-Hospet", "Ex-Chennai", "Ex-Coimbatore", "Ex-Gangaikondan", "Ex-Pune", "Ex-Goa", "Ex-Mumbai", "Ex-Nashik", "Ex-Aurangabad", "Ex-Goblej", "Ex-Hyderabad", "Ex - Vizag", "Ex-Vijayawada", "Ex-Chittoor", "Ex - Siliguri", "Ex-odhisha", "Ex-Jharkhand", "Ex-Bihar", "Ex-NorthEast", "Ex-Delhi", "Ex-Udaipur", "Ex-Jammu", "Ex-Haridwar", "Ex-Dasna", "Ex-Kanpur", "Ex-Unnao", "Ex-Var_anasi", "Ex-Bhopal")
Then inside your loop use the following:
least(i, m, n) = ActiveWorkbook.Sheets(Var(n)).Cells(i, m)
Create an array of your sheet
Dim Var
Var = Array("Ex-Bidadi"", "Ex-Hospet", "Ex-Chennai" ... till the last sheet)
Count the number of sheets that included on your array. Array starts at index 0.
For n = 0 to 28 '29 sheets less 1, because of the array index 0
For i = 3 To 445
For m = 28 To 40
ActiveWorkbook.Sheets(Var(n)).Cells(i, m) = 999999
least(i, m, n) = ActiveWorkbook.Sheets(Var(n)).Cells(i, m)
Next m
Next i
Next n
Loop through all sheets and pick just the ones you need in a SELECT CASE statement:
Sub Test()
Dim wrkSht As Worksheet
Dim i As Long, m As Long
Dim cLeast As Collection
Set cLeast = New Collection
For Each wrkSht In ThisWorkbook.Worksheets
'NB: If you want sheets that start with "Ex-" use commented lines instead:
'Select Case Left(wrkSht.Name, 3)
Select Case wrkSht.Name
'Case "Ex-"
Case "Ex-Bidadi", "Ex-Hospet", "Ex-Chnnai"
For i = 3 To 445
For m = 28 To 40
cLeast.Add wrkSht.Cells(i, m), wrkSht.Name & "|" & i & "|" & m
Next m
Next i
Case Else
'Code if not the sheet you're after.
End Select
Next wrkSht
Debug.Print cLeast("Ex-Bidadi|3|28")
End Sub
NB: I've used a collection in the loop as not sure what you're after. Dictionaries are probably the better way to go.
Related
The following code splits each lines into words and store the first words in each line into array list and the second words into another array list and so on. Then it selects the most frequent word from each list as correct word.
Module Module1
Sub Main()
Dim correctLine As String = ""
Dim line1 As String = "Canda has more than ones official language"
Dim line2 As String = "Canada has more than one oficial languages"
Dim line3 As String = "Canada has nore than one official lnguage"
Dim line4 As String = "Canada has nore than one offical language"
Dim wordsOfLine1() As String = line1.Split(" ")
Dim wordsOfLine2() As String = line2.Split(" ")
Dim wordsOfLine3() As String = line3.Split(" ")
Dim wordsOfLine4() As String = line4.Split(" ")
For i As Integer = 0 To wordsOfLine1.Length - 1
Dim wordAllLinesTemp As New List(Of String)(New String() {wordsOfLine1(i), wordsOfLine2(i), wordsOfLine3(i), wordsOfLine4(i)})
Dim counts = From n In wordAllLinesTemp
Group n By n Into Group
Order By Group.Count() Descending
Select Group.First
correctLine = correctLine & counts.First & " "
Next
correctLine = correctLine.Remove(correctLine.Length - 1)
Console.WriteLine(correctLine)
Console.ReadKey()
End Sub
End Module
My Question: How can I make it works with lines of different number of words. I mean that the length of each lines here is 7 words and the for loop works with this length (length-1). Suppose that line 3 contains 5 words.
EDIT: Accidentally had correctIndex where shortest should have been.
From what I can tell you are trying to see which line is the closest to the correctLine.
You can get the levenshtein distance using the following code:
Public Function LevDist(ByVal s As String,
ByVal t As String) As Integer
Dim n As Integer = s.Length
Dim m As Integer = t.Length
Dim d(n + 1, m + 1) As Integer
If n = 0 Then
Return m
End If
If m = 0 Then
Return n
End If
Dim i As Integer
Dim j As Integer
For i = 0 To n
d(i, 0) = i
Next
For j = 0 To m
d(0, j) = j
Next
For i = 1 To n
For j = 1 To m
Dim cost As Integer
If t(j - 1) = s(i - 1) Then
cost = 0
Else
cost = 1
End If
d(i, j) = Math.Min(Math.Min(d(i - 1, j) + 1, d(i, j - 1) + 1),
d(i - 1, j - 1) + cost)
Next
Next
Return d(n, m)
End Function
And then, this would be used to figure out which line is closest:
Dim correctLine As String = ""
Dim line1 As String = "Canda has more than ones official language"
Dim line2 As String = "Canada has more than one oficial languages"
Dim line3 As String = "Canada has nore than one official lnguage"
Dim line4 As String = "Canada has nore than one offical language"
Dim lineArray As new ArrayList
Dim countArray As new ArrayList
lineArray.Add(line1)
lineArray.Add(line2)
lineArray.Add(line3)
lineArray.Add(line4)
For i = 0 To lineArray.Count - 1
countArray.Add(LevDist(lineArray(i), correctLine))
Next
Dim shortest As Integer = Integer.MaxValue
Dim correctIndex As Integer = 0
For i = 0 To countArray.Count - 1
If countArray(i) <= shortest Then
correctIndex = i
shortest = countArray(i)
End If
Next
Console.WriteLine(lineArray(correctIndex))
I need to add a code (123456) into a line of text in a file.
\\ESSEX [D]\\\\\\Tina Richardes\\\\\\\\\\\\\\\\\\\\\\\
The code needs to be entered after the 3rd "\" so it would look something like this.
\\ESSEX [D]\123456\\\\\Tina Richardes\\\\\\\\\\\\\\\\\\\\\\\
The text is always located on line 124 of the file.
If the [D] is always there a short and easy way would be to do:
Dim MyString As String = "\\ESSEX [D]\\\\\\Tina Richardes\\\\\\\\\\\\\\\\\\\\\\\"
MyString = MyString.Insert(MyString.IndexOf("[D]") + 3, "123456")
Otherwise you could do:
Dim MyString As String = "\\ESSEX [D]\\\\\\Tina Richardes\\\\\\\\\\\\\\\\\\\\\\\"
Dim d As Integer = 0
For Each i As Match In Regex.Matches(MyString, "\\")
If d = 2 Then
MsgBox(MyString.Insert(i.Index + 1, "132456"))
End If
d = d + 1
Next
You can use File.ReadAllLines and File.WriteAllLines and string methods:
Dim lines = File.ReadAllLines(path)
If lines.Length < 124 Then Return
Dim line = lines(123)
Dim tokens = line.Split(New String() {"\"}, StringSplitOptions.None)
If tokens.Length < 4 Then Return
tokens(3) = "123456"
lines(123) = String.Join("\", tokens)
File.WriteAllLines(path, lines)
I would just loop through the string, counting the occurrences of the backslash and then exiting when you have found the third occurrence.
You would need to keep count of the index and then use this with the String.Insert method to insert the "123456" code:
Dim s As String = "\\ESSEX [D]\\\\\\Tina Richardes\\\\\\\\\\\\\\\\\\\\\\\"
Dim count As Integer = 0
Dim index As Integer = 0
For Each c In s
If c = "\" Then count += 1
index += 1
If count = 3 Then Exit For
Next
s = s.Insert(index, "123456")
Output:
\\ESSEX [D]\123456\\\\\Tina Richardes\\\\\\\\\\\\\\\\\\\\\\\
I am writing a user-defined function in excel vba. So this new function:
takes 4 input value
some calculation to generate into 8 numbers. ( 2 arrays - each array has 4 numbers)
do a chisquare test
return 1 output value
Code:
Sub test()
Dim A, B, C, D As Variant
A = 33
B = 710
C = 54
D = 656
'Observed Value
Dim O_A As Variant
Dim O_B As Variant
Dim O_V As Variant
Dim O_D As Variant
'Define Observer Value
O_C_A = 'Some Calucation'
O_C_B = 'Some Calucation'
O_T_C = 'Some Calucation'
O_T_C = 'Some Calucation'
'Expected Value
Dim E_C_A As Variant
Dim E_C_B As Variant
Dim E_T_C As Variant
Dim E_T_D As Variant
'Define Expected Value
E_C_A = 'Some Calucation'
E_C_B = 'Some Calucation'
E_T_C = 'Some Calucation'
E_T_D = 'Some Calucation'
'Create array(2x2)
Dim Chi_square_result As Variant
Dim my_array(1, 1)
my_array(0, 0) = O_C_Mesaurement
my_array(0, 1) = O_C_Balance
my_array(1, 0) = O_T_Measurement
my_array(1, 1) = O_T_Balance
Dim my_array2(1, 1)
my_array2(0, 0) = E_C_Mesaurement
my_array2(0, 1) = E_C_Balance
my_array2(1, 0) = E_T_Measurement
my_array2(1, 1) = E_T_Balance
'Create a chi square test formula'
Dim formula(1 To 5) As String
formula(1) = "CHITEST("
formula(2) = my_array
formula(3) = ","
formula(4) = my_array2
formula(5) = ")"
'Chi Square
Chi_square_result = evaluate(Join(formula, ""))
end sub
It gives a runtime error '13', saving type mismatch. This is because of the concatenation of the formula.
If you are writing a function, you have your format wrong.
Function Chi_square_result(A as Long, B as Long, C as Long, D as Long) as Double
'All your manipulations here
Chi_square_result = (Your math equation)
End Function
You also never defined my_array1, I am assuming it is supposed to be where you typed 'my_array'. I also do not think Join is your best bet. You are trying to do an awful lot of array manipulation, and I think your dimensions are getting you. It would be better to do it in a more straight forward way.
The evaluate is expecting worksheet cell ranges. Use the Excel Application object or WorksheetFunction object to compute the function within VBA.
This proofs out.
Dim dbl As Double
Dim my_array1(1, 1)
my_array1(0, 0) = 1
my_array1(0, 1) = 2
my_array1(1, 0) = 3
my_array1(1, 1) = 4
Dim my_array2(1, 1)
my_array2(0, 0) = 2
my_array2(0, 1) = 3
my_array2(1, 0) = 4
my_array2(1, 1) = 5
dbl = Application.ChiTest(my_array1, my_array2)
Debug.Print dbl
Result from the VBE's Immediate window: 0.257280177154182.
This question already has answers here:
How can I randomly select one of three strings?
(2 answers)
Closed 8 years ago.
I have three strings, sUpperCase, sLowerCase and sNumbers. Each have either lower characters, upper characters or numbers. I need to know how to randomly choose one of these strings. I have thought maybe by assigning them a number but I am not sure how do to this without overriding the text inside of them. Maybe even an array but I'm not sure how to do this either. Can anybody help please?
Dim sLowerCase As String = "qwertyuiopasdfghjklzxcvbnm"
Dim sUpperCase As String = "MNBVCXZLKJHGFDSAPOIUYTREWQ"
Dim sNumbers As String = "1234567890"
ANSWER:
Function GeneratePassword() As String
'
' Declare two strings as the characters which the password can be created from
Dim sLowerCase As String = "qwertyuiopasdfghjklzxcvbnm"
Dim sUpperCase As String = "MNBVCXZLKJHGFDSAPOIUYTREWQ"
Dim sNumbers As String = "1234567890"
' Create a new random.
' Random is something which gets a random set of characters from a string.
Dim random As New Random
'
' Create sPassword as a new stringbuilder
' A stringbuilder is simply a class which builds a string from multiple characters
Dim sPassword As New StringBuilder
' Not random enough
'For i As Integer = 1 To 4
' Dim idxUpper As Integer = random.Next(0, sUpperCase.Length - 1)
' sPassword.Append(sUpperCase.Substring(idxUpper, 1))
' Dim idxNumber As Integer = random.Next(0, sNumbers.Length - 1)
' sPassword.Append(sNumbers.Substring(idxNumber, 1))
' Dim idxLower As Integer = random.Next(0, sLowerCase.Length - 1)
' sPassword.Append(sLowerCase.Substring(idxLower, 1))
'Next
' Random select Upper, lower or numeric
' Check for a max number of this(three if's to check for which one it was, might need or in if)
' If yes randomly select another one
' If no get random char from that type
' Add to password
' Is the password complete?
' If yes return password, if not repeat
Dim iCountUpper As Integer = 0
Dim iCountLower As Integer = 0
Dim iCountNumber As Integer = 0
Do Until sPassword.Length = 10
'Needed help for this bit
Dim x = New Random(Now.GetHashCode)
Dim y = {"sLowerCase", "sUpperCase", "sNumbers"}
Dim z = y(x.Next(0, y.Length))
If z.Contains("sLowerCase") And iCountUpper < 4 Then
Dim idxUpper As Integer = random.Next(0, sUpperCase.Length - 1)
sPassword.Append(sUpperCase.Substring(idxUpper, 1))
iCountUpper = iCountUpper + 1
ElseIf z.Contains("sUpperCase") And iCountLower < 4 Then
Dim idxLower As Integer = random.Next(0, sLowerCase.Length - 1)
sPassword.Append(sLowerCase.Substring(idxLower, 1))
iCountLower = iCountLower + 1
ElseIf z.Contains("sNumbers") And iCountNumber < 2 Then
Dim idxNumber As Integer = random.Next(0, sNumbers.Length - 1)
sPassword.Append(sNumbers.Substring(idxNumber, 1))
iCountNumber = iCountNumber + 1
Else
End If
Loop
'
' Return the password as a string
Return sPassword.ToString
End Function
You could do something like this:
Dim sLowerCase As String = "qwertyuiopasdfghjklzxcvbnm"
Dim sUpperCase As String = "MNBVCXZLKJHGFDSAPOIUYTREWQ"
Dim sNumbers As String = "1234567890"
Dim x = New Random(Now.GetHashCode)
Dim y = {sLowerCase, sUpperCase, sNumbers}
Dim z = y(x.Next(0, y.Length))
Debug.Print(z)
Dim strings = {"qwertyuiopasdfghjklzxcvbnm", "MNBVCXZLKJHGFDSAPOIUYTREWQ", "1234567890"}
Dim selected As String
Dim Generator As System.Random = New System.Random()
selected = strings(Generator.Next(0, strings.GetUpperBound(0)))
Create an array with your strings:
Dim array As String() = New String() {sLowerCase, sUpperCase, sNumbers}
Use Random class to generate random number between 0 and the array lenght:
Dim random As Random = New Random(DateTime.Now.Ticks)
Dim randomChoose As String = array(random.Next(0, array.Length - 1))
Select a random char:
Dim ch As Char = randomChoose(random.Next(0, randomChoose.Length - 1))
I have a function in VBA that is supposed to sort text based on a "Bubble sort". If the text were just text then it would be fine, but my text is actually an alpha numeric string. I tried to rewrite it to account for the number part but something is still off and I can't seem to figure out what. Please help!!
Dim alphaCurr As String
Dim alphaNext As String
Dim rowCurr As FsChartRow
Dim rowNext As FsChartRow
Dim c As Integer
Dim n As Integer
Dim vTemp As Variant
For c = 1 To rows.count - 1
Set rowCurr = rows(c)
alphaCurr = GetAlpha(rowCurr.label)
For n = c + 1 To rows.count
Set rowNext = rows(n)
alphaNext = GetAlpha(rowNext.label)
If alphaCurr > alphaNext Then
Set vTemp = rows(n)
rows.Remove n
rows.Add vTemp, , c
End If
Next n
Next c
Dim numCurr As Integer
Dim numNext As Integer
Dim loopCount As Integer
For c = 1 To rows.count - 1
Set rowCurr = rows(c)
alphaCurr = GetAlpha(rowCurr.label)
numCurr = GetNumeric(rowCurr.label)
For n = c + 1 To rows.count
Set rowNext = rows(n)
alphaNext = GetAlpha(rowNext.label)
numNext = GetNumeric(rowNext.label)
If alphaCurr = alphaNext Then
If numCurr > numNext Then
Set vTemp = rows(n)
rows.Remove n
rows.Add vTemp, , c
End If
End If
Next n
Next c
The results I am getting are as follows:
"BK1"
"BK2"
"FB1"
"FB4"
"FB3"
"FB5"
"FB6"
"FB2"
"FJ2"
"FJ1"
"FJ3"
"FJ4"
"..."
"FJ15"
"RB1"
"H1"
"H2"
Thank for your help!
I have found a solution to my problem. I still could not get the bubble sort to work, so I created my own, that takes no more time to run then the bubble sort. I'll post in case it helps anyone.
Private Function SortFsChartRow(collection As collection) As collection
Dim min As Integer
Dim max As Integer
Dim x As Integer
Dim y As Integer
Dim rowCurr As FsChartRow
Dim numCurr As Integer
Dim rowMin As FsChartRow
Dim rowMax As FsChartRow
Dim search As Integer
Dim sorted As collection
Set sorted = New collection
min = 100
max = 0
For x = 1 To collection.count
Set rowCurr = collection(x)
numCurr = GetNumeric(rowCurr.label)
If numCurr > max Then
max = numCurr
Set rowMax = rowCurr
End If
If numCurr < min Then
min = numCurr
Set rowMin = rowCurr
End If
Next x
search = min
For y = 0 To max
For x = 1 To collection.count
Set rowCurr = collection(x)
numCurr = GetNumeric(rowCurr.label)
If numCurr = search Then
sorted.Add rowCurr
Exit For
End If
Next
search = search + 1
Next y
Set SortFsChartRow = sorted
End Function