I have 4 strings in variables a,b,c and d. I need to randomly order these variables in such a way so that I can input them into 4 different text boxes but not the same ones every time the program is ran.
I've tried to simplify it for myself by putting the strings into an array. Tell me what I'm doing wrong or if there's a way I could do it much easier.
Private Sub Random()
For i = 1 To 4
If a = 0 Then
a = r.Next(2, 5)
ElseIf b = 0 Then
Do Until b <> a
b = r.Next(2, 5)
Loop
ElseIf c = 0 Then
Do Until c <> a Or c <> b
c = r.Next(2, 5)
Loop
ElseIf d = 0 Then
Do Until d <> a Or d <> b Or d <> c
d = r.Next(2, 5)
Loop
End If
Next
End Sub
Here is one way to do it:
Dim a As String = "a"
Dim b As String = "b"
Dim c As String = "c"
Dim d As String = "d"
Dim all As String() = {a, b, c, d}
Dim random As New Random
Dim allRandom As String() = all.OrderBy(Function() random.Next).ToArray
Related
I'm writing VB Code and I see a question below
There are three positive integers A, B, C
If A is greater than B, C is equal to A+B
If A is less than or equal to B, then C is equal to A-B.
Please use IF...Then and Select/Switch Case to write a program, both of which are used in this program, and additional variables can be added by yourself.
I would like to ask how to write this question, as far as I know, the answer just need only IF Then or Select Case can be realized?
Dim A As Double = 3
Dim B As Double = 2
Dim C As Double = 1
Dim D As Double = 0
D = A - B
Select Case D
Case D > 0
C = A + B
Case D < 0
C = A - B
End Select
If D > 0 Then
C = A + B
ElseIf D < 0 Then
C = A - B
End If
In the real world you wouldn't need to use both an If/Then statement and a Select/Case statement. Since this appears to be homework, I believe the exercise is to see if you can use both conditional check.
I would setup two functions that accept two arguments (a and b) that return the value of c. In your first function use an If/Then and in your second function use a Select/Case.
E.g.
Private Function IfThenOption(a As Integer, b As Integer) As Integer
Dim c As Integer
If (a > b) Then
c = a + b
ElseIf (a < b) Then
c = a - b
Else
c = a
End If
Return c
End Function
Private Function SelectCaseOption(a As Integer, b As Integer) As Integer
Dim c As Integer
Select Case True
Case a > b
c = a + b
Case a < b
c = a - b
Case Else
c = a
End Select
Return c
End Function
Example: https://dotnetfiddle.net/kwcyWc
Inspired by a puzzle I saw online , and since I'm a VBA newbie, I thought it might be an interesting exercise to help me learn how to use For loops by making a brute force method to search for solutions to it.
This led to creating a monstrosity that takes ages to partially run and actually won't fully run at all.
All the code is meant to do is print 3 columns of valid combinations
Private Sub CommandButton1_Click()
Dim j As Long
Dim abc As String
Dim def As String
Dim ghi As String
j = 1
For a = 1 To 9
For b = 1 To 9
For c = 1 To 9
For d = 1 To 9
For e = 1 To 9
For f = 1 To 9
For g = 1 To 9
For h = 1 To 9
For i = 1 To 9
'Line breaks included for ease of reading
If a = b Or a = c Or a = d Or a = e Or a = f Or a = g Or a = h Or a = i
Or b = c Or b = d Or b = e Or b = f Or b = g Or b = h Or b = i
Or c = d Or c = e Or c = f Or c = g Or c = h Or c = i
Or d = e Or d = f Or d = g Or d = h Or d = i
Or e = f Or e = g Or e = h Or e = i
Or f = g Or f = h Or f = i
Or g = h Or g = i
Or h = i Then
Else
abc = a & b & c
def = d & e & f
ghi = g & h & i
ThisWorkbook.Sheets("Sheet1").Cells(j, 1).Value = abc
ThisWorkbook.Sheets("Sheet1").Cells(j, 2).Value = def
ThisWorkbook.Sheets("Sheet1").Cells(j, 3).Value = ghi
j = j + 1
End If
Next i
Next h
Next g
Next f
Next e
Next d
Next c
Next b
Next a
End Sub
This obviously involves lots of simple operations, and results in variously (Not Responding) messages or it just doesn't run. Was it possible to tell before clicking "Go" that that would be the case?
My job has me working on, and adding to, spread sheets that perform lots of operations on other spread sheets with conceivably hundreds of thousands of data items in each. Continuing to add functionality to these files may or may not be sustainable, I need to know how to tell before I sink time into further development.
Is there a hard limit to what can be done with VBA in terms of volumes/numbers of operations? Is there a tool that will estimate the viability of a macro actually running to completion? A heuristic commonly employed in industry?
Basically, what methods or tools exist to inform as to whether the demands of a macro or series of macros will exceed available memory?
Thanks
You should attempt to do a tiny bit of maths before you begin.
Your code generates all the permutations of 9 thing taken 9 at a time. Before you begin, you know this this will fill 362880 rows; so the code should work.
A separate issue is how much time will it take, and is this the most efficient method .
Not an answer, but can it be tackled by just looping the numbers? Something along these lines, is checking the 1st char against the rest
Dim l As Long
Dim i As Integer
For l = 11111111 To 99999999
For i = 2 To 8
DoEvents
If (Mid(l, i, 1) <> Mid(l, 1, 1)) Then
Debug.Print l
End If
Next i
Next l
I was doing a program about Bisection Method. I haven't encountered any errors while doing the program, but when I run it, input the data, and press the compute button, no answer is displayed, but a scroll bar appears and freezes the program.
I don't know what is wrong but I guess it has something to do with logical error.
Public Class Form1
Dim a As Double
Dim b As Double
Dim c As Double
Dim fa As Double
Dim fb As Double
Dim fc As Double
Dim err As Double
Dim n As Integer = 1
Dim x As Double
Dim diserr As String
Dim fas As String
Dim fbs As String
Dim fcs As String
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
a = TextBox1.Text
b = TextBox2.Text
err = TextBox3.Text
fa = a ^ 3 - a - 3
fb = b ^ 3 - b - 3
c = (a + b) / 2
fc = c ^ 3 - c - 3
x = Math.Abs(a - b)
Do While x > err
fa = a ^ 3 - a - 3
fb = b ^ 3 - b - 3
c = (a + b) / 2
fc = c ^ 3 - c - 3
x = Math.Abs(a - b)
If err < x Then
diserr = "No"
Else
diserr = "Yes"
End If
If fa > 0 Then
fas = "+"
Else
fas = "-"
End If
If fb > 0 Then
fbs = "+"
Else
fbs = "-"
End If
If fc > 0 Then
fcs = "+"
Else
fcs = "-"
End If
If diserr = "Yes" Then
fcs = Str(x)
End If
ListBox1.Items.Add(Str(n))
ListBox2.Items.Add(Str(a))
ListBox3.Items.Add(Str(b))
ListBox4.Items.Add(Str(c))
ListBox5.Items.Add(Str(x))
ListBox6.Items.Add(diserr)
ListBox7.Items.Add(fas)
ListBox8.Items.Add(fbs)
ListBox9.Items.Add(fcs)
n = n + 1
If fas = "-" And fcs = "+" Then
b = c
End If
If fbs = "-" And fcs = "+" Then
a = b
b = c
End If
Loop
End Sub
End Class
You need to consider the cases where fcs is "-".
If I'm not misunderstanding the method you can just replace the last two ifs with
If fas <> fcs Then
b = c
Else
a = b
b = c
End If
How to make first letter in upper case while pressing tab or space in vb 6.0 ?
My code is as follows
txtFirstName.Text = UCase$(txtFirstName.Text)
but it doesn't change after tab or space
It's just simple just do this in the text box keypress events...
Private sub textbox_keypress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Use the LostFocus event
Private Sub yourTextBox_LostFocus()
With yourTextBox
'first letter in upper case, the rest, untouched.
.Text = UCase(Mid(.Text, 1, 1)) & Mid(.Text, 2, Len(.Text))
End With
End Sub
Apply the same logic to the KeyDown event and check if the pressed key is the space key.
Private Sub yourTextBox_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 32 Then
With yourTextBox
'first letter in upper case, the rest, untouched.
.Text = UCase(Mid(.Text, 1, 1)) & Mid(.Text, 2, Len(.Text))
.SelStart = Len(.Text) 'put the cursor at the end of the textbox...
End With
End If
End Sub
StrConv Function
Returns a Variant (String) converted as specified.
Syntax
StrConv(string, conversion, LCID)
The StrConv function syntax has these named arguments:
Part Description
string Required. String expression to be converted.
conversion Required. Integer. The sum of values specifying the type of conversion to perform.
LCID Optional. The LocaleID, if different than the system LocaleID. (The system LocaleID is the default.)
Settings
The conversion argument settings are:
Constant Value Description
vbUpperCase 1 Converts the string to uppercase characters.
vbLowerCase 2 Converts the string to lowercase characters.
vbProperCase 3 Converts the first letter of every word in string to uppercase.
AND THERE IS MORE ...
TO GSERGE
$ means nothing when applied to a function name as opposed to a variable name. VBA uses $ AND B as a suffix to denote similar functionality.
VB6 IS VBA the person who said maybe in VB6 but not in VBA. VB6 program host VBA as their programming language. VB6 on it's own are some app objects and the forms package only - no programming language. It's best to think of VB6 as a VBA host like Office.
If you want to proper case see this WORDBASIC Ver 6 code, (which word 2003 helpfully converted to vba).
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Sub MAIN()
Select Case WordBasic.Int(GetModifer)
Case 0
WordBasic.ChangeCase
Case 1
WordBasic.ChangeCase 4
Case 2
WordBasic.ChangeCase 2
Case 3
ProperCase
Case Else
WordBasic.ChangeCase
End Select
End Sub
Private Sub ProperCase()
Dim F
Dim z
Dim a$
Dim P
F = 1
WordBasic.ChangeCase 2
WordBasic.EditBookmark Name:="SerenityChangeCase", SortBy:=0, Add:=1
z = WordBasic.GetSelEndPos()
WordBasic.CharLeft 1
While WordBasic.GetSelEndPos() < z And Not WordBasic.AtEndOfDocument()
WordBasic.SelectCurWord
a$ = WordBasic.[Selection$]()
P = 0
If LCase(a$) = "a" Then
P = 1
ElseIf LCase(a$) = "an" Then
P = 1
ElseIf LCase(a$) = "as" Then
P = 1
ElseIf LCase(a$) = "at" Then
P = 1
ElseIf LCase(a$) = "be" Then
P = 1
ElseIf LCase(a$) = "by" Then
P = 1
ElseIf LCase(a$) = "in" Then
P = 1
ElseIf LCase(a$) = "is" Then
P = 1
ElseIf LCase(a$) = "of" Then
P = 1
ElseIf LCase(a$) = "on" Then
P = 1
ElseIf LCase(a$) = "or" Then
P = 1
ElseIf LCase(a$) = "to" Then
P = 1
ElseIf LCase(a$) = "and" Then
P = 1
ElseIf LCase(a$) = "are" Then
P = 1
ElseIf LCase(a$) = "for" Then
P = 1
ElseIf LCase(a$) = "the" Then
P = 1
ElseIf LCase(a$) = "from" Then
P = 1
ElseIf LCase(a$) = "what" Then
P = 1
ElseIf LCase(a$) = "with" Then
P = 1
End If
If P = 1 And F = 0 Then WordBasic.Insert LCase(a$)
WordBasic.WordRight 1
F = 0
Wend
WordBasic.WW7_EditGoTo Destination:="SerenityChangeCase"
WordBasic.EditBookmark Name:="SerenityChangeCase", SortBy:=0, Delete:=1
End Sub
Private Function GetModifer()
Dim a
Dim B
Dim c
Dim X
a = GetAsyncKeyState(16)
B = GetAsyncKeyState(17)
c = GetAsyncKeyState(18)
X = 0
If a < 0 Then X = X + 1
If B < 0 Then X = X + 2
If c < 0 Then X = X + 4
GetModifer = X
End Function
OK. Yeah txtFirstName is a good indicator of usage here.. So I'd use (sort of) Title Caps And I'd do it on the Validate event.. So
Private Sub txtFirstName_Validate(Cancel As Boolean)
Dim p As Integer ' i doubt we'll use more than 32K for a name....
Dim mName As String
p = 1
' first off lets trim any leading blanks.. assume NOTHING and make sure its all lower case..
mName = LCase(LTrim(txtFirstName))
Do While p > 0 And p <= Len(txtFirstName) ' start with the first non-blank
Mid(mName, p, 1) = UCase(Mid(mName, p, 1))
p = InStr(p, mName, " ")
If p > 0 And p < Len(mName) Then p = p + 1
Loop
Cancel = False
txtFirstName = mName
End Sub
Works every time, and capitalizes each word.. Didn't add any code to to do TRUE title caps but this is close, and short & easy...
When I put in a binary number it gives me more than one result in messagebox.show.
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim s As String
Dim a, b, c As Long
a = CLng(Val(TxtBoxInput.Text))
s = TxtBoxInput.Text
TxtBoxInput.Clear()
For i = 1 To Len(s) Step 1
b = CLng(Mid(s, i, 1))
c = Len(s) - i
b = CLng(Val(b) * (2 ^ c))
TxtBoxInput.Text = CStr(MessageBox.Show(CStr(Val(TxtBoxInput.Text) + b)))
Next i
End Sub
You would use the MsgBox Method. It is uncertain from your example where the result is that you are wanting to show.
MsgBox("Information Here", MsgBoxStyle.Information, "MyTitle")
Edit based on Comments
Put your MessageBox outside of your loop something like this:
Dim s, temp As String
Dim a, b, c As Long
a = CLng(Val(TxtBoxInput.Text))
s = TxtBoxInput.Text
TxtBoxInput.Clear()
For i = 1 To Len(s) Step 1
b = CLng(Mid(s, i, 1))
c = Len(s) - i
b = CLng(Val(b) * (2 ^ c))
temp = CStr(Val(temp) + b)
Next i
MessageBox.Show(temp)
Dim s As String
Dim a, b, c As Long
a = CLng(Val(TxtBoxInput.Text))
s = TxtBoxInput.Text
TxtBoxInput.Clear()
For i = 1 To Len(s) Step 1
b = CLng(Mid(s, i, 1))
c = Len(s) - i
b = CLng(Val(b) * (2 ^ c))
TxtBoxInput.Text = CStr(Val(TxtBoxInput.Text) + b)
Next i
MSGBOX(TXTBOXINPUT)