8/9/2011, 9:36 am
Nếu bạn nào thắc mắc về thuật toán sử dụng trong chương trình tạo nhóm random mà mình đã đưa ra thì mình xin share mà lệnh macro mà mình đã sử dụng!
(bài viết được edit lại bởi kienhl do bài viết của bạn này spam linh tinh!
Sub MakeGroups()
'
' This macro is to take a classlist at column A on
' a spreadsheet and divide those members into groups
' with a size defined at B2.
' Group size must be a positive number greater than 1.
' If a group does not divide evenly then:
' If only one extra member then assign to last group
' If two or more extra members then form a new group
'
' 8/2/2006 Jim Pollard
'
'
Dim class As Range
Dim Members As Range
'get the size of the groups and test for > 1
groupSize = Int(Range("number_per_group"))
If groupSize < 2 Then
MsgBox "Ah, come on. You can't have a group with fewer than 2 people!"
Range("number_per_group").Select
Exit Sub
End If
' Find the class members
Set class = Range("A2", Range("A2").End(xlDown))
' Find the number in the class
n = class.Rows.Count
' Temporarily create a column of names and an
' associated column of random numbers
Randomize
Set Members = Range("e2", Range("f2").Offset(n - 1, 0))
For i = 1 To class.Rows.Count
Members(i, 1) = class(i)
Members(i, 2) = Rnd()
Next i
' Sort by the random numbers to put the list in random order
Members.Sort Members.Columns(2)
' Take each member in order from the random list and
' fill the groups
ActiveSheet.Columns(3).Clear
Range("c1").Select
ActiveCell = "Groups"
ActiveCell.Font.Bold = True
ActiveCell.Offset(1, 0).Select
ActiveCell.Font.Bold = True
randomMember = 1
For groupNumber = 1 To n \ Range("number_per_group")
ActiveCell = "Group " & groupNumber
ActiveCell.Font.Bold = True
' fill one group
For groupMember = 1 To groupSize
ActiveCell.Offset(groupMember, 0) = Members(randomMember, 1)
randomMember = randomMember + 1
Next groupMember
' skip a space after each group
ActiveCell.Offset(groupMember + 1, 0).Select
Next groupNumber
' the even groups are filled
' Now check for extras
leftovers = n - (randomMember - 1)
If leftovers > 1 Then
' make a new group if more than one extra
ActiveCell = "Group " & i
ActiveCell.Font.Bold = True
ActiveCell.Offset(1, 0).Select
Else
' add the extra to the last group if only one
ActiveCell.Offset(-1, 0).Select
End If
For i = 1 To leftovers
ActiveCell = Members(randomMember, 1)
ActiveCell.Offset(1, 0).Select
randomMember = randomMember + 1
Next i
' Get rid of the temporary data
ActiveSheet.Columns(5).Clear
ActiveSheet.Columns(6).Clear
End Sub
Sub PickSomebody()
Dim class As Range
Set class = Range("A2", Range("A2").End(xlDown))
n = class.Rows.Count
MsgBox class(Int((n + 1) * Rnd + lowerbound), 1)
End Sub
(bài viết được edit lại bởi kienhl do bài viết của bạn này spam linh tinh!
Sub MakeGroups()
'
' This macro is to take a classlist at column A on
' a spreadsheet and divide those members into groups
' with a size defined at B2.
' Group size must be a positive number greater than 1.
' If a group does not divide evenly then:
' If only one extra member then assign to last group
' If two or more extra members then form a new group
'
' 8/2/2006 Jim Pollard
'
'
Dim class As Range
Dim Members As Range
'get the size of the groups and test for > 1
groupSize = Int(Range("number_per_group"))
If groupSize < 2 Then
MsgBox "Ah, come on. You can't have a group with fewer than 2 people!"
Range("number_per_group").Select
Exit Sub
End If
' Find the class members
Set class = Range("A2", Range("A2").End(xlDown))
' Find the number in the class
n = class.Rows.Count
' Temporarily create a column of names and an
' associated column of random numbers
Randomize
Set Members = Range("e2", Range("f2").Offset(n - 1, 0))
For i = 1 To class.Rows.Count
Members(i, 1) = class(i)
Members(i, 2) = Rnd()
Next i
' Sort by the random numbers to put the list in random order
Members.Sort Members.Columns(2)
' Take each member in order from the random list and
' fill the groups
ActiveSheet.Columns(3).Clear
Range("c1").Select
ActiveCell = "Groups"
ActiveCell.Font.Bold = True
ActiveCell.Offset(1, 0).Select
ActiveCell.Font.Bold = True
randomMember = 1
For groupNumber = 1 To n \ Range("number_per_group")
ActiveCell = "Group " & groupNumber
ActiveCell.Font.Bold = True
' fill one group
For groupMember = 1 To groupSize
ActiveCell.Offset(groupMember, 0) = Members(randomMember, 1)
randomMember = randomMember + 1
Next groupMember
' skip a space after each group
ActiveCell.Offset(groupMember + 1, 0).Select
Next groupNumber
' the even groups are filled
' Now check for extras
leftovers = n - (randomMember - 1)
If leftovers > 1 Then
' make a new group if more than one extra
ActiveCell = "Group " & i
ActiveCell.Font.Bold = True
ActiveCell.Offset(1, 0).Select
Else
' add the extra to the last group if only one
ActiveCell.Offset(-1, 0).Select
End If
For i = 1 To leftovers
ActiveCell = Members(randomMember, 1)
ActiveCell.Offset(1, 0).Select
randomMember = randomMember + 1
Next i
' Get rid of the temporary data
ActiveSheet.Columns(5).Clear
ActiveSheet.Columns(6).Clear
End Sub
Sub PickSomebody()
Dim class As Range
Set class = Range("A2", Range("A2").End(xlDown))
n = class.Rows.Count
MsgBox class(Int((n + 1) * Rnd + lowerbound), 1)
End Sub