How can I shorten this code? I want to make this code with If shorter in loop. I tried do something like this Me.Controls("x" & t) = 0 , but it's returning a syntax error. I don't know what I can do. Please help.
x = CStr(Int(Rnd() * 16))
Dim x1 As Byte = 0
...
Dim x30 As Byte = 0
For t = 0 To 15
If x = t And x1 = 0 Then
...
End If
If x = t And x2 = 0 Then
...
End If
...
If x = t And x30 = 0 Then
...
End If
Array are the best solution. First decide whether its one or two dimensional and then you can use it. I beleive yours is a two dimensional array.
You can set X1 to X30 in array and fetch the values. A mock code for both one and two dimensional array is here
1-D Array:
Dim Films(1 To 5) As String
Films(1) = "Lord of the Rings"
Films(2) = "Speed"
Films(3) = "Star Wars"
Films(4) = "The Godfather"
Films(5) = "Pulp Fiction"
MsgBox Films(4)
2-D Array
Dim Films(1 To 5, 1 To 2) As String
Dim i As Integer, j As Integer
For i = 1 To 5
For j = 1 To 2
Films(i, j) = Cells(i, j).Value
Next j
Next i
MsgBox Films(4, 2)
Please mark it as answer if this help(can help someone too).
Regards,
Mani
Related
I have a set which has an unknown number of objects. I want to associate a label to each one of these objects. Instead of labeling each object with a number I want to label them with letters.
For example the first object would be labeled A the second B and so on.
When I get to Z, the next object would be labeled AA
AZ? then BA, BB, BC.
ZZ? then AAA, AAB, AAC and so on.
I'm working using Mapbasic (similar to VBA), but I can't seem to wrap my head around a dynamic solution. My solution assumes that there will be a max number of objects that the set may or may not exceed.
label = pos1 & pos2
Once pos2 reaches ASCII "Z" then pos1 will be "A" and pos2 will be "A". However, if there is another object after "ZZ" this will fail.
How do I overcome this static solution?
Basically what I needed was a Base 26 Counter. The function takes a parameter like "A" or "AAA" and determines the next letter in the sequence.
Function IncrementAlpha(ByVal alpha As String) As String
Dim N As Integer
Dim num As Integer
Dim str As String
Do While Len(alpha)
num = num * 26 + (Asc(alpha) - Asc("A") + 1)
alpha = Mid$(alpha, 2,1)
Loop
N = num + 1
Do While N > 0
str = Chr$(Asc("A") + (N - 1) Mod 26) & str
N = (N - 1) \ 26
Loop
IncrementAlpha = str
End Function
If we need to convert numbers to a "letter format" where:
1 = A
26 = Z
27 = AA
702 = ZZ
703 = AAA etc
...and it needs to be in Excel VBA, then we're in luck. Excel's columns are "numbered" the same way!
Function numToLetters(num As Integer) As String
numToLetters = Split(Cells(1, num).Address(, 0), "$")(0)
End Function
Pass this function a number between 1 and 16384 and it will return a string between A and XFD.
Edit:
I guess I misread; you're not using Excel. If you're using VBA you should still be able to do this will the help of an reference to an Excel Object Library.
This should get you going in terms of the logic. Haven't tested it completely, but you should be able to work from here.
Public Function GenerateLabel(ByVal Number As Long) As String
Const TOKENS As String = "ZABCDEFGHIJKLMNOPQRSTUVWXY"
Dim i As Long
Dim j As Long
Dim Prev As String
j = 1
Prev = ""
Do While Number > 0
i = (Number Mod 26) + 1
GenerateLabel = Prev & Mid(TOKENS, i, 1)
Number = Number - 26
If j > 0 Then Prev = Mid(TOKENS, j + 1, 1)
j = j + Abs(Number Mod 26 = 0)
Loop
End Function
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
Public Enum eSourceMode
AUS = 0
EIN = 1
End Enum
Public Structure tSourceChannel
Dim OnOff() As eSourceMode
Dim chan_nr As Short
End Structure
I'm trying to set value to
For i = gSources.GetLowerBound(0) To gSources.GetUpperBound(0) Step 1
gSources(i).chan_nr = i
'gSources is 0 based ?
If gSources.GetLowerBound(0) = 0 Then
k = i + 1
Else
k = i
End If
Dim hehe As Integer = gSources.Count
For j = gNoiseBands.GetLowerBound(0) To gNoiseBands.GetUpperBound(0) Step 1
'ab 17.1.2012: gNrSources sets nr of available outputs
If k <= gNrSources Then
gSources(i).OnOff(j) = eSourceMode.EIN
Else
gSources(i).OnOff(j) = eSourceMode.AUS
End If
Next j
Next i
result is exception
System.NullReferenceException occurred
Object reference not set to an instance of an object.
I need this, because I have .ini file and these values :
"gSources0",1,0,1,1,1,1,1
"gSources1",1,1,1,1,1,1,1
"gSources2",1,1,1,1,1,1,1
"gSources3",1,1,1,1,1,1,1
Result of should be for an example :
gSources(0).OnOff(0) = 1 , gSources(0).OnOff(1) = 0
Here you declare that OnOff is an array
Dim OnOff() As eSourceMode
but you never define how large the array should be or assign memory to the array.
'...
Dim hehe As Integer = gSources.Count
'Specify array size
Redim gSources(i).OnOff(gNoiseBands.GetUpperBound(0) - gNoiseBands.GetLowerBound(0))
For j = gNoiseBands.GetLowerBound(0) To gNoiseBands.GetUpperBound(0) Step 1
'...
Next j
This function goes through all integers and picks out binary values with only five ones and writes them to the spreadsheet.
To run this For x = 1 To 134217728 would take 2.5 days!!!! Help!
How could I speed this up?
Function D2B(ByVal n As Long) As String
n = Abs(n)
D2B = ""
Do While n > 0
If n = (n \ 2) * 2 Then
D2B = "0" & D2B
Else
D2B = "1" & D2B
n = n - 1
End If
n = n / 2
Loop
End Function
Sub mixtures()
Dim x As Long
Dim y As Integer
Dim fill As String
Dim mask As String
Dim RowOffset As Integer
Dim t As Date
t = Now
fill = ""
For x = 1 To 134217728
mask = Right(fill & CStr(D2B(x)), Len(fill & CStr(D2B(x))))
Debug.Print mask
If x > 100000 Then Exit For
If Len(mask) - Len(WorksheetFunction.Substitute(mask, "1", "")) = 5 Then _
RowOffset = RowOffset + 1
For y = 1 To Len(mask)
If Len(mask) - Len(WorksheetFunction.Substitute(mask, "1", "")) = 5 Then _
Range("mix").Offset(RowOffset).Cells(y) = Mid(mask, y, 1)
Next
Next
Debug.Print DateDiff("s", Now, t)
End Sub
By first sight guess, I think the problem lies in the fact that you do that cell by cell, which causes many read and write accesses.
You should do it range by range, like
vArr = Range("A1:C1000").Value
' it is array now, do something here effeciently
Range("A1:C1000").Value = vArr
You want find all 28bit numbers with 5 1s
There are 28*27*26*25*24/5/4/3/2=98280 such numbers
The following code took ~10 seconds on my PC:
lineno = 1
For b1 = 0 To 27
For b2 = b1 + 1 To 27
For b3 = b2 + 1 To 27
For b4 = b3 + 1 To 27
For b5 = b4 + 1 To 27
Cells(lineno, 1) = 2 ^ b1 + 2 ^ b2 + 2 ^ b3 + 2 ^ b4 + 2 ^ b5
lineno = lineno + 1
Next
Next
Next
Next
Next
mask = Right(fill & CStr(D2B(x)), Len(fill & CStr(D2B(x))))
The above line of code does the same thing (CStr(D2B(x))) twice.
Store the result of CStr(D2B(x)) in a variable & use that variable in the above line of code.
I've got 2 suggestions:
Get rid of the substitution command by counting the ones/zeroes in D2B and return an empty string if the count does not equal 5
Write these pre-filtered bitstrings to an array first and copy the array directly to the cells when finished.
Something like
ws.Range(ws.cells(1, 1), ws.cells(UBound(dstArr, 1) + 1, UBound(dstArr, 2) + 1)) = dstArr
The array-copy-trick greatly improves performance!