Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 5 years ago.
Improve this question
well i want enter a number in excel and give me 4 digit Combinations Of it.how can i do that? like this i enter 8 and give me
2 2 2 2
2 3 2 1
5 1 1 1
etc
Run sub phoniX():
Sub phoniX()
Dim N As Long, ary(1 To 4) As Long
N = Application.InputBox(prompt:="enter value", Type:=1)
xxx = 1
For i = 0 To N
For J = 0 To N
For k = 0 To N
For l = 0 To N
If i + J + k + l = N Then
ary(1) = i
ary(2) = J
ary(3) = k
ary(4) = l
Call LittleSort(ary())
Cells(xxx, 1).Value = "'" & ary(1) & ary(2) & ary(3) & ary(4)
xxx = xxx + 1
End If
Next l
Next k
Next J
Next i
Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Public Sub LittleSort(ByRef InOut)
Dim i As Long, J As Long, Low As Long
Dim Hi As Long, Temp As Variant
Low = LBound(InOut)
Hi = UBound(InOut)
J = (Hi - Low + 1) \ 2
Do While J > 0
For i = Low To Hi - J
If InOut(i) > InOut(i + J) Then
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
For i = Hi - J To Low Step -1
If InOut(i) > InOut(i + J) Then
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
J = J \ 2
Loop
End Sub
to produce:
Related
Here i have a piece of code that should generate random numbers from 5 to 50 in the range A2:C24,but for whatever reason it doesnt work also i need it to show and color with different colors the filled cells and the frequency of the element from cell C3.
Sub Random()
Dim Numbers(5 To 50) As Variant
Dim i As Long, j As Long, k As Long
For k = 5 To 50
Numbers(k) = k
Next k
Call Shuffle(Numbers)
k = 1
For Each r In Range("A2:C24")
r.Value = Numbers(k)
k = k + 1
Next r
End Sub
Sub Shuffle(InOut() As Variant)
Dim HowMany As Long, i As Long, j As Long
Dim tempF As Double, temp As Variant
Hi = UBound(InOut)
Low = LBound(InOut)
ReDim Helper(Low To Hi) As Double
Randomize
For i = Low To Hi
Helper(i) = Rnd
Next i
j = (Hi - Low + 1) \ 2
Do While j > 0
For i = Low To Hi - j
If Helper(i) > Helper(i + j) Then
tempF = Helper(i)
Helper(i) = Helper(i + j)
Helper(i + j) = tempF
temp = InOut(i)
InOut(i) = InOut(i + j)
InOut(i + j) = temp
End If
Next i
For i = Hi - j To Low Step -1
If Helper(i) > Helper(i + j) Then
tempF = Helper(i)
Helper(i) = Helper(i + j)
Helper(i + j) = tempF
temp = InOut(i)
InOut(i) = InOut(i + j)
InOut(i + j) = temp
End If
Next i
j = j \ 2
Loop
End Sub
Fairly straightforward route in Excel would be use function RANDBETWEEN since you are dealing with range.
Public Sub GenerateRandomNumbers()
'\\ This will generate random numbers...
With Range("A2:C24")
.Formula = "=RANDBETWEEN(5,50)"
.Value = .Value
End With
'\\ Rest of the code for your requirement goes here
'...
End Sub
I'm trying to create a list of random numbers that don't duplicate and then I want to take those numbers and generate multiple lists that are all random.
for example
for cells A1-A10 i want random numbers from 1-100
and then for A11-20 I want random numbers from 1-100
and then for A21 - A30 I want random number from 1-100
dragging down and repeating this seems possible with the MOD and OFFSET function which I'm still learning about.
For generating numbers I've tried
=RANDBETWEEN(1,100)
but it produces duplicates.
Ive also tried
Putting
Rand()
in G1 and generating random numbers
and then using
=RANK.EQ(G1,$G$1:$G$100)
along with:
=INDEX($H$1:$H$100, RANK(G1,$G$1:$G$100), 1)
which is better and doesn't produce duplicates but since i need multiple lists what happens is every list has the exact same data since the code is just replicating the same reference.
e.g : what i get is A1-10
A1 = 65
A2 = 54
A3 = 23
A4 = 31
A10= 23
then i try repeat the code for A11 - A 20
but it produces the same values.
even if i use
=INDEX($H$1:$H$50, RANK.EQ(G2, $G$1:$G$100) + COUNTIF($G$1:G2, G2) - 1, 1)
and then i have
=INDEX($H$1:$H$100, RANK(G1,$G$1:$G$100), 1)
in two differnt rows they produce the exact same random numbers
So i reckoned I need something that randomises every time.
Any help is appreciated
Try the following VBA macro:
Sub vRandom()
Dim mn As Long, mx As Long, samples As Long
Dim times As Long, arr1(), t As Long, s As Long
Dim k As Long
mn = 1
mx = 100
samples = 10
times = 3
k = 1
ReDim arr1(mn To mx)
For s = mn To mx
arr1(s) = s
Next s
For t = 1 To times
Call Shuffle(arr1)
For s = 1 To samples
Cells(k, 1) = arr1(mn + s - 1)
k = k + 1
Next s
Next t
End Sub
Public Sub Shuffle(InOut() As Variant)
Dim i As Long, J As Long
Dim tempF As Double, Temp As Variant
Hi = UBound(InOut)
Low = LBound(InOut)
ReDim Helper(Low To Hi) As Double
Randomize
For i = Low To Hi
Helper(i) = Rnd
Next i
J = (Hi - Low + 1) \ 2
Do While J > 0
For i = Low To Hi - J
If Helper(i) > Helper(i + J) Then
tempF = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = tempF
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
For i = Hi - J To Low Step -1
If Helper(i) > Helper(i + J) Then
tempF = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = tempF
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
J = J \ 2
Loop
End Sub
The code produces 3 blocks of items (10 items in each block).
Within a block there are no duplicates, but there may be duplicates between blocks.
I'm trying to randomize a cell value for each cell. I want to keep the letters "tyot" at the front of the word, then randomize the 7 letters after it, which I did with this formula:
=CHAR(RANDBETWEEN(65,90)) & CHAR(RANDBETWEEN(65,90)) & CHAR(RANDBETWEEN(65,90)) & CHAR(RANDBETWEEN(65,90))& CHAR(RANDBETWEEN(65,90))&RANDBETWEEN(10,99)
and after joining both cells with a formula like =A1&""&B1 I got the results that i want which it looks like this tyotXKWAE73. Now the next step is what i cant figure it out, which is randomizing the last six letter "tXKWAE73" and leaving "tyot"always on the front. Any ideas on how to do this last step?
Enter the following functions in a standard module:
Public Function Shuffle(s As String) As String
Dim ary(1 To 7) As String, ndex(1 To 7)
For i = 1 To 7
ary(i) = Mid(s, i, 1)
ndex(i) = i
Next i
Call Shuffle2(ndex)
Shuffle = ""
For i = 1 To 7
Shuffle = Shuffle & ary(ndex(i))
Next i
End Function
Public Sub Shuffle2(InOut() As Variant)
Dim i As Long, J As Long
Dim tempF As Double, Temp As Variant
Hi = UBound(InOut)
Low = LBound(InOut)
ReDim Helper(Low To Hi) As Double
Randomize
For i = Low To Hi
Helper(i) = Rnd
Next i
J = (Hi - Low + 1) \ 2
Do While J > 0
For i = Low To Hi - J
If Helper(i) > Helper(i + J) Then
tempF = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = tempF
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
For i = Hi - J To Low Step -1
If Helper(i) > Helper(i + J) Then
tempF = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = tempF
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
J = J \ 2
Loop
End Sub
Then in B1 enter:
=CHAR(RANDBETWEEN(65,90)) & CHAR(RANDBETWEEN(65,90)) & CHAR(RANDBETWEEN(65,90)) & CHAR(RANDBETWEEN(65,90))& CHAR(RANDBETWEEN(65,90))&RANDBETWEEN(10,99)
In B2 enter:
="tyot" & shuffle(B$1)
and copy downward:
Each entry in column B is a "randomization" of B1 with a fixed prefix.
well, i write a code for get All Possible Combinations Of a number in 4 digit
and worked well, but i want send each number to opposite Cells
Dim N As Long, ary(1 To 4) As Long
N = Application.InputBox(prompt:="enter value", Type:=1)
xxx = 1
For i = 0 To N
For J = 0 To N
For k = 0 To N
For l = 0 To N
If i + J + k + l = N Then
ary(1) = i
ary(2) = J
ary(3) = k
ary(4) = l
Call LittleSort(ary())
Cells(xxx, 1).Value = "'" & ary(1) & ary(2) & ary(3) & ary(4)
xxx = xxx + 1
End If
Next l
Next k
Next J
Next i
Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Public Sub LittleSort(ByRef InOut)
Dim i As Long, J As Long, Low As Long
Dim Hi As Long, Temp As Variant
Low = LBound(InOut)
Hi = UBound(InOut)
J = (Hi - Low + 1) \ 2
Do While J > 0
For i = Low To Hi - J
If InOut(i) > InOut(i + J) Then
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
For i = Hi - J To Low Step -1
If InOut(i) > InOut(i + J) Then
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
J = J \ 2
Loop
End Sub
and worked well, but i want send each number to opposite Cells
like this
write this code for do that
Sub Text_To_Cols()
Dim ary()
Dim Num As Long, i As Long
Num = Len(Range("A1").Value) - 1
ReDim ary(0 To Num)
For i = 0 To Num
ary(i) = Array(i, 1)
Next i
Range("A1").TextToColumns Destination:=Range("B1"), _
DataType:=xlFixedWidth, FieldInfo:=ary
End Sub
My problem is that my 4 numbers are divided into 5 numbers
how can i do that?
I want a vba code which all rows contain the values 1..n (n dependent from txt files) exactly once. Some cells have already values from the txt files.
That is what i did but it is not give to me that i want:
Function randomnum(n As Integer, ProbMatrix() As Integer) As Integer
Dim k As Integer, newvalue As Integer
newvalue = Int(n * Rnd + 1)
For i = 1 To n
For k = 1 To n
If ProbMatrix(i, k) = newvalue Then
newvalue = RandInt(n)
k = 0
End If
Next k
randomnum = newvalue
Next i
End function
Here is an example for a single cell, cell A1Place a value in A1 and run sub Routine() to produce a list of random numbers in the adjacent cells:
Sub Routine()
Dim i As Long, MMX As Long
MMX = Range("A1").Value
ReDim ary(1 To MMX) As Variant
For i = 1 To MMX
ary(i) = i
Next i
Call Shuffle(ary)
For i = 1 To MMX
Cells(1, 1 + i).Value = ary(i)
Next i
End Sub
Sub Shuffle(InOut() As Variant)
Dim HowMany As Long, i As Long, J As Long
Hi = UBound(InOut)
Low = LBound(InOut)
ReDim Helper(Low To Hi) As Double
Randomize
For i = Low To Hi
Helper(i) = Rnd
Next i
J = (Hi - Low + 1) \ 2
Do While J > 0
For i = Low To Hi - J
If Helper(i) > Helper(i + J) Then
Temp = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = Temp
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
For i = Hi - J To Low Step -1
If Helper(i) > Helper(i + J) Then
Temp = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = Temp
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
J = J \ 2
Loop
End Sub
For example: