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?
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 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.
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:
I have a dataset in an Excel sheet and i need to RANDOMLY split this (for instance 999 records) into 3 equal (and no duplicates) Excel files. Can this be done simply by using some Excel function or I need to write code to specifically do this?
Sometimes low-tech is best. If you don't need to repeat this very frequently...
add a column to the dataset, fill with =RAND()
sort the dataset on this column
copy the first 333 rows into a new sheet
copy the next 333 rows into a new sheet
I bet that would take less time than you've already spent trying to get the macros to work.
This revised macro will take the original 999 records and randomly distribute them into three other files (each file containing exactly 333 items) :
Sub croupier()
Dim k1 As Long, k2 As Long, k3 As Long
Dim Original As Workbook
Dim I As Long, ary(1 To 999)
Set Original = ActiveWorkbook
Dim rw As Long
Workbooks.Add
Set Winken = ActiveWorkbook
Workbooks.Add
Set Blinken = ActiveWorkbook
Workbooks.Add
Set Nod = ActiveWorkbook
k1 = 1
k2 = 1
k3 = 1
For I = 1 To 999
ary(I) = I
Next I
Call Shuffle(ary)
With Original.Sheets("Sheet1")
For I = 1 To 333
rw = ary(I)
.Cells(rw, 1).EntireRow.Copy Winken.Sheets("Sheet1").Cells(k1, 1)
k1 = k1 + 1
Next I
For I = 334 To 666
rw = ary(I)
.Cells(rw, 1).EntireRow.Copy Blinken.Sheets("Sheet1").Cells(k2, 1)
k2 = k2 + 1
Next I
For I = 667 To 999
rw = ary(I)
.Cells(rw, 1).EntireRow.Copy Nod.Sheets("Sheet1").Cells(k3, 1)
k3 = k3 + 1
Next I
End With
Winken.Save
Blinken.Save
Nod.Save
Winken.Close
Blinken.Close
Nod.Close
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
Here is a macro that will accept an array and copy to three different sheets:
Sub DoWork(Students As Variant)
Dim i As Long
Dim row As Integer
Dim sheetNumber As Integer
ReDim myArray(UBound(Students)) As Variant
Dim shuffledArray As Variant
Dim wkSheet As Worksheet
Dim myBooks(3) As Workbook
Set myBooks(1) = workBooks.Add
Set myBooks(2) = workBooks.Add
Set myBooks(3) = workBooks.Add
'populate the array with the number of rows
For i = 1 To UBound(Students)
myArray(i) = i
Next
'shuffle the array to provide true randomness
shuffledArray = ShuffleArray(myArray)
sheetNumber = 1
row = 1
'loop through the rows assiging to sheets
For i = 1 To UBound(Students)
If sheetNumber = 4 Then
sheetNumber = 1
row = row + 1
End If
Set wkSheet = myBooks(sheetNumber).ActiveSheet
wkSheet.Cells(row, 1) = Students(shuffledArray(i))
sheetNumber = sheetNumber + 1
Next
myBooks(1).SaveAs ("ws1.xlsx")
myBooks(2).SaveAs ("ws2.xlsx")
myBooks(3).SaveAs ("ws3.xlsx")
End Sub
Function ShuffleArray(InArray() As Variant) As Variant()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArray
' This function returns the values of InArray in random order. The original
' InArray is not modified.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
Dim Temp As Variant
Dim J As Long
Dim Arr() As Variant
Dim L As Long
Randomize
L = UBound(InArray) - LBound(InArray) + 1
ReDim Arr(LBound(InArray) To UBound(InArray))
For N = LBound(InArray) To UBound(InArray)
Arr(N) = InArray(N)
Next N
For N = LBound(Arr) To UBound(Arr)
J = CLng(((UBound(Arr) - N) * Rnd) + N)
Temp = Arr(N)
Arr(N) = Arr(J)
Arr(J) = Temp
Next N
ShuffleArray = Arr
End Function
Sub ShuffleArrayInPlace(InArray() As Variant)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArrayInPlace
' This shuffles InArray to random order, randomized in place.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
Dim L As Long
Dim Temp As Variant
Dim J As Long
Randomize
L = UBound(InArray) - LBound(InArray) + 1
For N = LBound(InArray) To UBound(InArray)
J = CLng(((UBound(InArray) - N) * Rnd) + N)
If N <> J Then
Temp = InArray(N)
InArray(N) = InArray(J)
InArray(J) = Temp
End If
Next N
End Sub
You would then call with something like this:
Option Explicit
Option Base 1
Sub Test()
Dim i As Long
Dim Students(999) As Variant
'populate the array with the number of rows
For i = 1 To UBound(Students)
Students(i) = "Students-" & Str(i)
Next
DoWork (Students)
End Sub
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: