So I'm developing a minesweeper game and im assigning the mines, but i'm unable to create a algorithm to stop a mine to go to a place where there's already a mine, here's what i have so far:
Public Sub initflags()
Dim line, column As Integer
For line = 0 To 9
For column = 0 To 9
mat(line, column) = 0
Next
Next
Dim numbandeiras As Integer
Dim r, c As Integer
Do Until numbandeiras = 34
Randomize()
line = Int(Rnd() * 10)
column = Int(Rnd() * 10)
r = line
c = column
If r And c = 1 Then
mat(line, column) = 0
Else
numbandeiras = numbandeiras + 1
Call avisinhos()
mat(line, column) = 1
End If
Loop
End Sub
Could someone help me?
Best regards, joao.
The simplest thing to do is to check before setting, e.g:
if mat(line, column) = 0 then
numbandeiras = numbandeiras + 1
avisinhos()
mat(line, column) = 1
end if
You need to store all placed "mines" in an array of some sort. This is better in the end if you want to do something with those mines. If you have mines as objects it makes them even better for now they can have states like dead, alive or "?" like MS version.
Just my 2 cents.
Related
VBA dice roll is very easy thing even for me, but I need specific type, when rolling 6 means you can roll again and add the two rolls together (plus when you roll 6 twice in a row, you get third roll and so on).
I have tried two approaches, but both failed
Sub roll_dice_1()
Dim result As Range
Set result = Range("A1")
result = Application.WorksheetFunction.RandBetween(1, 6)
If result = 6 Then
result = result + Application.WorksheetFunction.RandBetween(1, 6)
Do Until Application.WorksheetFunction.RandBetween(1, 6) <> 6
result = result + Application.WorksheetFunction.RandBetween(1, 6)
Loop
Else
End If
End Sub
This one however can produce result of 12, which is clearly impossible, because twice 6 should give third roll
Sub roll_dice_2()
Dim result As Range
Set result = Range("A1")
result = Application.WorksheetFunction.RandBetween(1, 6)
If result = 6 Then
Do Until Application.WorksheetFunction.RandBetween(1, 6) <> 6
result = result + Application.WorksheetFunction.RandBetween(1, 6)
Loop
Else
End If
End Sub
This one works even worse, because it can return 6.
I tried search high and low, but all that I got were simple codes for simple throws, rolls with two dices and rolls when certain results can be rerolled. Again all options pretty easy, unlike this one
Your issue is you're generating a random number to test against and then generating a different one to add to your result. They need to be the same. Also VBA has it's own random function.
Sub roll_dice()
Dim result As Integer, roll as Integer
Dim lowerbound As Integer, upperbound As Integer
lowerbound = 1
upperbound = 6
result = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
If result = upperbound Then
roll = result
Do While roll = upperbound
roll = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
result = result + roll
Loop
End If
MsgBox result
End Sub
The loop is wrong. You cannot roll in the condition and then roll again to accumulate as these are already 2 rolls.
Basically what you need is a loop where the condition comes last, e.g.
Result = 0
Do
Roll =...
Result = result + roll
Loop while roll <> 6
Seems the issue if the handling of 6, if it is to thow reroll, then you should implement:
...
roll = 6
do while roll = 6
roll = Int(( 6 * Rnd + 1)
ShowRoll(roll)
loop
DoStuffWithRollValue
...
this will show every roll until row is 1-5
ShowRoll is the call to the animation or other method of showing the roll
Sub roll_dice()
Dim die1, die2 As Integer
'Randomize
die1 = (Hour(Rnd) Mod 6) + 1
die2 = (Hour(Rnd) Mod 6) + 1
Exit Sub
I have a routing sequence for a set of machines on an assembly line. Each route has to go through the entire line (that is, if you only run the first and second machine, you still account for the distance from the second to the end of the line).
I have six different machines (720 possible combinations of machines) with fixed distances between each location on the line. The distance between the first and second machine is 100', the distance between second and third is 75', third and fourth is 75', fourth and fifth is 25', and fifth and sixth is 25'.
I have 4 different products that have to run down the line, and each of them have a fixed routing.
My problem is, how do I set up a vba code or solver that will allow me to run through all possible combinations of the line setup and determine the optimal setup for this line? Any machine can be placed at any location, as long as it optimizes the result!
The four product routes are :
A - B - C - D - F
A - C - B - D – E - F
A - F - E - D - C - B - A - F
A - C - E - B - D – F
Running through all possible combinations - if you really need to do that - is a job for something like Heap's algorithm, although I prefer the plain changes method:
Sub Evaluate(Lineup() As String)
' dummy evaluation, just output the permutation
Dim OffCell As Long
For OffCell = LBound(Lineup, 1) To UBound(Lineup, 1)
ActiveCell.Offset(0, OffCell).Value = Lineup(OffCell)
Next OffCell
ActiveCell.Offset(1, 0).Activate
End Sub
Sub AllPerms(Lineup() As String)
' Lineup is a 1-D array indexed at 1
Dim LSize As Long
Dim Shift() As Long
Dim Tot As Long
Dim Idx As Long
Dim Level As Long
Dim Change As Long
Dim Offset As Long
Dim TempStr As String
LSize = UBound(Lineup)
ReDim Shift(LSize)
'count of permutations, set initial changes
Tot = 1
For Idx = 2 To LSize
Tot = Tot * Idx
Shift(Idx) = 1 - Idx
Next Idx
Shift(1) = 2 ' end condition
' go through permutations
For Idx = 1 To Tot
' check this one
Call Evaluate(Lineup)
' switch for the next
Level = LSize
Offset = 0
Change = Abs(Shift(Level))
Do While Change = 0 Or Change = Level
If Change = 0 Then Shift(Level) = 1: Offset = Offset + 1
If Change = Level Then Shift(Level) = 1 - Level
Level = Level - 1
Change = Abs(Shift(Level))
Loop
Shift(Level) = Shift(Level) + 1
Change = Change + Offset
TempStr = Lineup(Change)
Lineup(Change) = Lineup(Change + 1)
Lineup(Change + 1) = TempStr
Next Idx
End Sub
Sub ABCDEF_case()
Dim LU(6) As String
LU(1) = "A"
LU(2) = "B"
LU(3) = "C"
LU(4) = "D"
LU(5) = "E"
LU(6) = "F"
Call AllPerms(LU)
End Sub
I am getting the "next without for" error. I checked other questions on this and looked for any open if statements or loops in my code, but could find none. I'm need an extra set of eyes to catch my error here.
I am trying to loop through this code and advance the torque value 3 times each times it gets to the 30th i.
'This is Holzer's method for finding the torsional natural frequency
Option Explicit
Sub TorsionalVibrationAnalysis_()
Dim n As Integer 'position along stucture
Dim m As Integer
Dim i As Long 'frequency to be used
Dim j As Variant 'moment of inertia
Dim k As Variant 'stiffness
Dim theta As Long 'angular displacement
Dim torque As ListRow 'torque
Dim lambda As Long 'ListRow 'omega^2
Dim w As Variant
Dim s As Long
'equations relating the displacement and torque
n = 1
Set j = Range("d2:f2").Value 'Range("d2:f2").Value
Set k = Range("d3:f3").Value
'initial value
Set w = Range("B1:B30").Value
For i = 1 To 30
'start at 40 and increment frequency by 20
w = 40 + (i - 1) * 20
lambda = w ^ 2
theta = 1
s = 1
Do While i = 30 & s <= 3
torque = lambda * j(1, s)
s = s + 1
End
m = n + 1
theta = theta - torque(i, n) / k(n)
torque(i, m) = torque(i, n) + lambda * j(m) * theta
If m = 4 & i < 30 Then
w(i) = 40 + (i - 1) * 20
lambda = w(i) ^ 2
ElseIf m = 4 & i >= 30 Then
Cells([d], [5+i]).display (i)
Cells([e], [5+i]).display (theta)
Cells([f], [5+i]).display (torque)
Else
End If
If m <> 4 Then
n = n + 1
End If
Next i
End Sub
You are trying to terminate your While with an End instead of Loop
Try changing your End to Loop in your Do While loop. I think you are terming the loop when you hit that End
Proper indentation makes the problem rather apparent.
You have:
For i = 1 To 30
'...
Do While i = 30 & s <= 3
'...
End
'...
If m = 4 & i < 30 Then
'...
ElseIf m = 4 & i >= 30 Then
'...
Else
End If
If m <> 4 Then
'...
End If
Next i
But run it through Rubberduck's Smart Indenter and you get:
For i = 1 To 30
'...
Do While i = 30 & s <= 3
'...
End
'...
If m = 4 & i < 30 Then
'...
ElseIf m = 4 & i >= 30 Then
'...
Else
End If
If m <> 4 Then
'...
End If
Next i
End Sub
Notice how the End other answers are pointing out, is clearly not delimiting the Do While loop.
The Next i is inside the Do While block, which isn't terminated - when the VBA compiler encounters that Next i, it doesn't know how it could possibly relate to any previously encountered For statement, and thus issues a "Next without For" compile error.
Use an indenter.
I am currently making a highscore table - reading the times from a .csv file and sorting them from lowest to highest. The list only becomes partially sorted after the code runs.
All the data inputs correctly but when it goes to sort it sorts the data out incorrectly.
Private Sub BeginnerProcess(ByRef player() As pe_player, ByVal x As Integer)
Dim i As Integer
Dim j As Integer
Dim temp As Object
For i = x To 0 Step -1
For j = 0 To i - 1
If player(j).playerTime > player(j + 1).playerTime Then
temp = player(j)
player(j) = player(j + 1)
player(j + 1) = temp
End If
Next
Next
Dim k As Integer
For k = 1 To x
player(k).position = k
Next
End Sub
Here's the output
Leaderboard
Adapting the classic bubble-sort to your case, I think i should be something like the code below:
For i = 0 To x - 1
For j = i + 1 To x
If player(i).playerTime > player(j).playerTime Then
temp = player(i)
player(i) = player(j)
player(j) = temp
End If
Next
Next
I'm currently having a slight issue duplicating a row and incrementing the sequence number.
So based on a button click, this is how I'm duplicating row 0, duplicated only one time per click.
Dim dr As DataRow
For n As Integer = 0 To 0 ' how many dupes you want
dr = tbl.NewRow
For c As Integer = 0 To tbl.Columns.Count - 1 ' copy data from 0 to NewRow
dr.Item(c) = tbl.Rows(0).Item(c)
Next
tbl.Rows.Add(dr) ' add NewRow to datatable
Next n
Here's how I'm creating the sequence number, pads with leading zeros, which seems to increment, but only after I click the duplicate button, so essentially the last row added, it the duplicated row 0, but doesn't represent the new sequence number needed.
'UPDATE SEQUENCE NUMBER
i += 1
Dim value As Integer = i
Dim r As Integer
Dim decimalLength1 As Integer = value.ToString("D").Length + 7
Dim decimalLength2 As Integer = value.ToString("D").Length + 6
Dim decimalLength3 As Integer = value.ToString("D").Length + 5
Dim decimalLength4 As Integer = value.ToString("D").Length + 4
If i >= 0 And i <= 9 Then
'1 TO 9 FORMAT
DataGridView1.CurrentCell = DataGridView1.CurrentRow.Cells("sequence")
DataGridView1.Item(73, r).Value = value.ToString("D" + decimalLength1.ToString())
'Debug.Print(value.ToString("D" + decimalLength1.ToString()))
ElseIf i >= 10 And i <= 99 Then
'10 TO 99 FORMAT
DataGridView1.CurrentCell = DataGridView1.CurrentRow.Cells("sequence")
DataGridView1.Item(73, r).Value = value.ToString("D" + decimalLength2.ToString())
'Debug.Print(value.ToString("D" + decimalLength1.ToString()))
ElseIf i >= 100 And i <= 999 Then
'100 TO 999 FORMAT
DataGridView1.CurrentCell = DataGridView1.CurrentRow.Cells("sequence")
DataGridView1.Item(73, r).Value = value.ToString("D" + decimalLength3.ToString())
'Debug.Print(value.ToString("D" + decimalLength1.ToString()))
ElseIf i >= 1000 And i <= 9999 Then
'1000 TO 9999 FORMAT
DataGridView1.CurrentCell = DataGridView1.CurrentRow.Cells("sequence")
DataGridView1.Item(73, r).Value = value.ToString("D" + decimalLength4.ToString())
'Debug.Print(value.ToString("D" + decimalLength1.ToString()))
End If
Row 0 will always have a sequence number of 1, so in theory I need to start incrementing at 2.
Suggestions? Is there a better/cleaner way of doing this?
UPDATE 2
Dim startSeq As Integer = Convert.ToInt32(tbl.Rows(0).Item(73))
MsgBox("startSeq = " & startSeq)
For n As Integer = 0 To NumericUpDown1.Value - 1
MsgBox("n = " & n)
dr = tbl.NewRow
For c As Integer = 0 To tbl.Columns.Count - 1
dr.Item(c) = tbl.Rows(0).Item(c)
If c = "73" Then ' if this is the SEQ column,
' add the current seq val to the seq column
dr.Item(c) = (startSeq + n).ToString("00000000")
End If
Next c
tbl.Rows.Add(dr)
Next n
It seems like you should be able to add the sequencer as you create the duplicates. Perhaps make it a method and pass the index of the column which has the sequence string. Something like:
Private Sub DuplicateRows(ColIndx As Integer,
Dupes As Integer)
' start value is Row(0) + 1
Dim startSeq As Integer = Convert.ToInt32(tbl.Rows(0).Item(ColIndx )) + 1
For n As Integer = 0 to Dupes -1
dr = tbl.NewRow
For c As Integer = 0 To tbl.Columns.Count - 1
If c = ColIndx Then ' if this is the SEQ column,
' add the current seq val to the seq column
dr.Item(c) = (startSeq + n).ToString("00000000")
Else
' otherwise copy the data from Row(0)
dr.Item(c) = tbl.Rows(0).Item(c)
End If
Next c
tbl.Rows.Add(dr)
Next n
End Sub
This should initialize each new row with an incremented counter. Is there a better/cleaner way of doing this
a) you should be adding to the DataTable, not the DGV if it is bound
b) (startSeq + n).ToString("00000000") should work to do the padding etc instead of that ugly block of code.
c) Use Option Strict On. If c = "73" ... is nonsense which makes the compiler guess at your intentions. Its is bug food.
d) Hardcoding "73" may work this time, but previously you said it could be anywhere. The code below finds the sequence column based on the name so it can appear anywhere. Rather than a form level var, you could find it just before you make the dupes or even in the Dupes procedure.
e) Dim startSeq As Integer = Convert.ToInt32(tbl.Rows(0).Item(73)) if you examine the answer above, this should be ... + 1 to increment the first value.
Usage:
Private tbl As DataTable ' table loaded from flat file
Private SeqColIndex As Integer ' assigned somewhere to
' point to the "sequence" column
' method to load data
Dim connstr = "Provider=Microsoft.ACE.OLEDB.12.0;..."
Using cn As New OleDbConnection(connstr)
...
End Using
' FIND the sequence column for this session
For n = 0 To tbl.Columns.Count - 1
If tbl.Columns(n).ColumnName.ToLowerInvariant = "sequence" Then
SeqColIndex = n
Exit For
End If
Next
' later to add some rows
Private Sub ButtonAddRow_Click(...
DuplicateRows(SeqColIndex, NumericUpDown1.Value)
End Sub