I am trying ti fill arrays based on conditions, and it seems my sample code is sticking values in the wrong position. I included the position where it is being altered. I tried doing some basic +1/-1 fixes but so far all these efforts have misplaced things or returned various other errors.
to be more clear- the issue is that in the v loop, the value is being stuck in the (o,0) position instead of the (o,v) position (over writing the previous value).
I thought the way I had it structured would for each loop perform o's criteria and then check for v's criteria and in turn when v would loop would enter the value in the v position that is equal to the current value of o?
Im clearly missing something and any pointers in the correct direction would be gladly appreciated
Dim Cbox(9, 1)
For o = LBound(Cbox, 1) To UBound(Cbox, 1)
If LPDif2 = 0 Then
Cbox(o, 0) = 0
ElseIf LPDif2 < 3 And LPDif2 > 0 Then
CCount = CCount + LPDif2
Cbox(o, 0) = LPDif2
Else
CCount = CCount + 3
Cbox(o, 0) = 3
LPDif2 = CNLP - CCount
End If
LPDif2 = CNLP - CCount
If CCount = CNLP Then BCount = BCount + 1
WCount = WCount + CW
If CCount < CNLP And CCount >= Round(CLng(CNLP) / 2 + 0.000001, 0) Then DCount = DCount + 1
If CCount >= CNLP Then DCount = DCount + 2
For v = LBound(Cbox, 2) To UBound(Cbox, 2)
If CCount >= Round(CLng(CNLP) / 2 + 0.000001, 0) And DCount = 1 Then
Cbox(o, v) = "Green"
If CTCombo = "9 W" Then
AXWCount = WCount / 2
WH.Value = Ceiling(AXWCount, 9)
Else
WH.Value = WCount
End If
End If
Next v
Next o
Based on the comments, the code inside of the inner loop should only be running if the value of v is 1. It should be as simple as just eliminating the inner loop entirely and hard coding the value "1":
For o = LBound(Cbox, 1) To UBound(Cbox, 1)
'...
If CCount >= Round(CLng(CNLP) / 2 + 0.000001, 0) And DCount = 1 Then
Cbox(o, 1) = "Green"
If CTCombo = "9 W" Then
AXWCount = WCount / 2
WH.Value = Ceiling(AXWCount, 9)
Else
WH.Value = WCount
End If
End If
Next o
Related
I am trying to make a simple VBA in Excel, to copy some data I am trying to regroup. I seems to work good for some part, but it skips a row and column everytime! The problem must be somewhere in the double For..Next.. I am using, but I can't find it:
The result I get:
For i = 1 To AantalPag 'HIERRR
GezSite = BeginCel.Offset(i + 1) 'HIERRR
For iweek = 1 To AantalWeek
GezWeek = BeginCel.Offset(0, iweek)
For i2 = 1 To AantalWeekData
If BeginCelData.Offset(i2 - 1) = GezWeek Then
For i3 = 1 To AantalSitesData
If BeginCelData.Offset(0, i3) = GezSite Then
Sommetje = Sommetje + BeginCelData.Offset(i2 - 1, i3 - 1)
Else
i3 = i3 + 1
End If
Next i3
'BeginCel.Offset(i, iweek) = Sommetje
'Sommetje = 0
Else
i2 = i2 + 1
End If
Next i2
BeginCel.Offset(i, iweek) = Sommetje
Sommetje = 0
iweek = iweek + 1
Next iweek
i = i + 1
Next i
The code below will print the numbers from 1 to 100 in the Immediate window.
For n = 1 to 100
Debug.Print n
Next n
The code below will print every other number in the Immediate window. This is because n is incremented both by n = n + 1 and then again by Next n.
For n = 1 to 100
Debug.Print n
n = n + 1
Next n
j = LBound(arrayTime)
Do Until j = UBound(arrayTime)
j = j + 1
b = b + 1
cnc = b + r
MsgBox cnc
If cnc > 7 Then
b = 0
r = 0
cnc = b + r
End If
numMins = Sheet5.Cells(cnc + 3, 2) - arrayTime(j)
If numMins < 0 Then
g = g + 1
ReArrangeArray arrayTime, j
'ReDim Preserve arrayTime(numrows - 1 + g)
'arrayTime(numrows - 1 + g) = arrayTime(j)
'MsgBox (arrayTime(numrows - 1 + g))
Else
Sheet5.Cells(cnc + 3, 2) = numMins
End If
Loop
If the if statement is true I want to be able to put the array value at the end of the array and remove that value from its current spot. As the code is, it just adds it to the end and increases the size of the array from 12 to 13. How can I get the array to remain size 12 and still place the value at the end of the array and then remove it from its original position? I do not want to touch the array values in front. Just want to take that value and move it to the end.
For instance
array(1,2,3,4,5)
If statement
j on third loop.
array(j)=3
end array should be
array(1,2,4,5,3)
You could use a helper Sub like this one:
Sub ReArrangeArray(inputArray as Variant, indexToSwap as long)
Dim I As Long
Dim tempVal As Variant
If indexToSwap >= LBound(inputArray) And indexToSwap < UBound(inputArray) Then
tempVal = inputArray(indexToSwap)
For I = indexToSwap To UBound(inputArray) - 1
inputArray(i) = inputArray(i + 1)
Next I
InputArray(UBound(inputArray)) = tempVal
End If
End Sub
To be called by your main Sub as follows:
ReArrangeArray arrayTime, j
I'm creating a connect four game and I'm having some trouble with the horizontal loop. The loop below works and it's for a vertical win. I have a two labels for each row and two labels for each column one for the color blue and one for the color red. When I add in my other labels I cant seem to find where I take the step-1 in order to change labels and go upwards with the next label. I have also tried adding a whole new loop below that just dedicated to the horizontal winnings.
For i = 5 To 0 Step -1`
If board(i, 0) = 0 Then
board(i, 0) = pturn
If pturn = 1 Then
Labelboard(i, 0).BackColor = Color.Red
CounterB = 0
lblcounterBlue.Text = "Matches = " & CounterB
CounterR = CounterR + 1
lblCounterRed.Text = "Matches = " & CounterR
ElseIf pturn = 2 Then
Labelboard(i, 0).BackColor = Color.Blue
CounterR = 0
lblCounterRed.Text = "Matches = " & CounterR
CounterB = CounterB + 1
lblcounterBlue.Text = "Matches = " & CounterB
End If
pturn = pturn + 1
If pturn = 3 Then pturn = 1
If CounterR = 4 Then
MsgBox("Game Over")
End If
If CounterB = 4 Then
MsgBox("Game Over")
End If
Exit Sub
End If
Next
I don't quite understand your setup, but hopefully this will get you close enough for you to get things working. I'm having to make a few assumptions, but I've tried to declare a constant each time I have to make the code more readable and easier for you to adapt to what you've already written.
What I've written is a function that lets you know if a specific space is part of winning streak. It assumes board() is public. If pturn is also public, you could make this even more efficient as long as you call it every turn, as noted in the comments. If you know which space was the last one played, you can maximize efficiency by only calling the function for that space (assuming you call it at the end of every player turn). If you don't know which space was played last, you can loop through every space in board() and test each one.
Function winner(rowNum As Integer, colNum As Integer) As Integer
'Returns 0 if space does not create a win, or the winning player number if it does
'Change to winner(...) As Boolean <--To only test current player
Dim minRow As Integer = LBound(board, 0)
Dim maxRow As Integer = UBound(board, 0)
Dim minColumn As Integer = LBound(board, 1)
Dim maxColumn As Integer = UBound(board, 1)
'These are the values I assume are in board()
'(I don't actually use them in the code)
Const emptySpace As Integer = 0
Const red As Integer = 1
Const blue As Integer = 2
Dim player As Integer
Dim streak As Integer
Dim r As Integer, c As Integer 'loop placeholders
Dim v As Integer, h As Integer 'control search direction
For v = 0 To 1
For h = -1 To 1
If v = 1 Or h = 1 Then
'These loops and test check each direction (vertical, horizontal and
'both diagonals) for a win exactly once.
player = board(rowNum, colNum)
If player > 0 Then 'If player = pturn <-- to only check current player
streak = 1
'check positive direction
r = rowNum + h
c = colNum + v
Do While r >= minRow And r <= maxRow And c >= minColumn And c <= maxColumn
If board(r, c) = player Then
streak = streak + 1
If streak = 4 Then
Return player 'True <--If testing only current player
Else
r = r + h
c = c + v
End If
Else
Exit Do
End If
Loop
'check negative direction
r = rowNum - h
c = colNum - v
Do While r >= minRow And r <= maxRow And c >= minColumn And c <= maxColumn
If board(r, c) = player Then
streak = streak + 1
If streak = 4 Then
Return player 'True <--If testing only current player
Else
r = r - h
c = c - v
End If
Else
Exit Do
End If
Loop
End If
End If
Next h
Next v
Return 0 'Function has completed and no winner was found
'Return False <-- If only testing current player
End Function
(Visual Basic)
This is the word file I'm reading from:
`#+/084&"
#3*#%#+
8%203:
,1$&
!-*%
.#&33&
#*#71%
&-&641'2
#))85
9&330*
Download link: http://www.filehosting.org/file/details/465979/words.txt
I am trying to find all the different characters and symbols inside the word files, and then count them, and output them as a frequency. For example ("The symbol '#' appears (8) times"), ("The number(0) appears (3) times") etc.
I am using a 2 dimensional array and storing the symbols in the first column and the amount of times they appear in the second.
This is my current code:
Sub Main()
Dim UncodedWords(10) As String
Dim Symcheck(19, 3) As String
Dim X As Integer = 0
Symcheck(0, 0) = ("+")
Symcheck(0, 1) = ("0")
Symcheck(1, 0) = ("/")
Symcheck(1, 1) = ("0")
Symcheck(2, 0) = ("’")
Symcheck(2, 1) = ("0")
Symcheck(3, 0) = ("&")
Symcheck(3, 1) = ("0")
Symcheck(4, 0) = (":")
Symcheck(4, 1) = ("0")
Symcheck(5, 0) = ("$")
Symcheck(5, 1) = ("0")
Symcheck(6, 0) = ("-")
Symcheck(6, 1) = ("0")
Symcheck(7, 0) = ("!")
Symcheck(7, 1) = ("0")
Symcheck(8, 0) = (".")
Symcheck(8, 1) = ("0")
Symcheck(9, 0) = ("""")
Symcheck(9, 1) = ("0")
Symcheck(10, 0) = ("0")
Symcheck(10, 1) = ("0")
Symcheck(11, 0) = ("1")
Symcheck(11, 1) = ("0")
Symcheck(12, 0) = ("2")
Symcheck(12, 1) = ("0")
Symcheck(13, 0) = ("3")
Symcheck(13, 1) = ("0")
Symcheck(14, 0) = ("4")
Symcheck(14, 1) = ("0")
Symcheck(15, 0) = ("5")
Symcheck(15, 1) = ("0")
Symcheck(16, 0) = ("6")
Symcheck(16, 1) = ("0")
Symcheck(17, 0) = ("7")
Symcheck(17, 1) = ("0")
Symcheck(18, 0) = ("8")
Symcheck(18, 1) = ("0")
Symcheck(19, 0) = ("9")
Symcheck(19, 1) = ("0")
Dim Newtext(10) As String
Dim FileLoc As String = "C:\Users\Downloads\words.txt"
Dim StringReader As New StreamReader(FileLoc, FileMode.Open)
For Counter = 0 To 9 ' for each line in the file
UncodedWords(Counter) = StringReader.ReadLine
Next
For Counter = 0 To 9 ' for each word in the file
For length = 1 To Len(UncodedWords(Counter)) - 1
For Counter2 = 0 To 19 ' for each symbol in symcheck
If UncodedWords(Counter).Contains(Symcheck(Counter2, 0)) Then
X += 1
Else
End If
WriteLine(Symcheck(Counter2, 0))
WriteLine(Symcheck(Counter2, X))
Next
Next
Next
End Sub
End Module
There are a lot of ways to do this.
One simple, though not necessarily efficient, method is to begin with an empty Symcheck. Then check each character in the input string. If you've encountered the character before (i.e., if it's in Symcheck; use IndexOf), increment its counter. Otherwise, add it to Symcheck with zero count.
This is what a hash map (hash table) is used for.
Loop through each character in the txt file, and perform a check. If the key exists in the hash map, then increment that keys value, else add the key with a value of 0.
Psuedocode:
For each letter in txtFile
If (HashMap.KeyExists(letter)) then
HashMap(letter).Value += 1
Else
HashMap.Add(letter, 0)
End If
Next
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.