CNTT4A2 COMMUNITY

Thảo luận học tập


You are not connected. Please login or register

Go downThông điệp [Trang 1 trong tổng số 1 trang]

8/9/2011, 9:36 am
avatar
avatar

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

11

Thích

Báo xấu [0]

Gửi một bình luận lên tường nhà BlueSky

Về Đầu TrangThông điệp [Trang 1 trong tổng số 1 trang]

« Xem bài trước | Xem bài kế tiếp »

Bài viết mới cùng chuyên mục

      Quyền hạn của bạn:

      Bạn không có quyền trả lời bài viết