EXCEL技巧——VBA自动给体育比赛分组-Excel教程

在日常举行的体育比赛中，分组是比较难办的事情，因为牵扯到天时地利人和的因素，如果不能合适的分好组，会落得很多抱怨，这里我们通过VBA代码来实现比赛的随机自动分组，这样就避免了一些不必要的麻烦。

前期准备工作（包括相关工具或所使用的原料等）

EXCEL软件

详细的操作方法或具体步骤

新建一张表格，在表格中输入以下内容：

“姓名 性别 班级 往届成绩”，如图所示。

单击菜单栏“开发工具”——Visualbasic，打开VBA编辑器，我们将在其中输入代码。

单击菜单栏“插入”——模块，打开代码编辑框，现在我们就可以在其中插入代码来了。

现在我们来插入代码：

Option Explicit

Sub FenZu()

Dim arr, arr1(), arr2(), arr11, arr22, i&, j&, m&, n&, arrD(), p1

Dim rng As Range, p As Long, zs(), rs As Long, d, darr1, darr2, str As String

Application.ScreenUpdating=False

Set d=CreateObject("Scripting.Dictionary")

arr=Sheets("sheet1").Range("a3:d15")

str="请输入分组数"

line1:

p1=Application.InputBox(prompt:=str, Type:=1)

If p1=False Then Exit Sub

If Int(p1) <> p1 Or p1 > UBound(arr) / 2 Or p1 < 2 Then

str="分组数不合法，请重新输入！"

GoTo line1

If

p=p1

rs=-Int(-UBound(arr) / p)

ReDim zs(1 To p)

For i=1 To p

zs(i)=rs

Next

For i=1 To rs * p - UBound(arr)

zs(i)=zs(i) - 1

Next

ReDim arrD(1 To UBound(arr), 1 To 5)

ReDim arr1(1 To UBound(arr) - p): ReDim arr2(1 To p)

arr11=dhrand(1, UBound(arr) - p): arr22=dhrand(1, p)

For i=1 To UBound(arr)

If arr(i, 4)="" Then

m=m + 1

If m <=UBound(arr1) Then

arr1(m)=i

Else

n=n + 1: arr2(n)=i

If

Else

n=n + 1

If n <=UBound(arr2) Then

arr2(n)=i

Else

m=m + 1: arr1(m)=i

If

If

Next

m=1

For i=1 To p

d(m)=zs(i): m=m + zs(i)

Next

m=0: n=0

For i=1 To UBound(arrD)

If d.exists(i) Then

m=m + 1

For j=2 To 5

arrD(i, j)=arr(arr2(arr22(m)), j - 1)

Next

Else

n=n + 1

For j=2 To 5

arrD(i, j)=arr(arr1(arr11(n)), j - 1)

Next

If

Next

With Sheets(1)

.Range("3:10000").Clear

.Range("b3").Resize(UBound(arrD), UBound(arrD, 2))=arrD

With

darr1=d.keys: darr2=d.items

For i=1 To p

Set rng=Sheets(1).Range("b" & darr1(i - 1) + 2).Resize(darr2(i - 1), 5)

rng.BorderAround ColorIndex:=5, Weight:=xlThick

rng.Cells(1)="第" & Format(i, "00") & "组"

rng.Columns(1).Merge

Next

Sub

Function dhrand(il As Long, ih As Long) As Variant

Dim aintValues() As Long, arr() As Long, intI&, intP&

ReDim aintValues(1 To ih - il + 1)

ReDim arr(1 To ih - il + 1)

For intI=il To ih

aintValues(intI - il + 1)=intI

Next intI

For intI=ih - il + 1 To 1 Step -1

intP=Int(Rnd * intI) + 1

arr(intI)=aintValues(intP)

aintValues(intP)=aintValues(intI)

Next intI

dhrand=arr

Function

现在回到EXCEL表格，单击“开发工具”——插入——按钮，拖住十字箭头画出一个矩形按钮，弹出对话框。选择宏“fenzu”，单击确定。

现在右键单击按钮，选择“编辑文字”，现在吧按钮名称改为“自动分组”。

现在单击自动分组按钮，弹出对话框“请输入分组数”，输入“3”，单击确定，我们就看到分好的组了。

经验内容仅供参考，如果您需解决具体问题(尤其法律、医学等领域)，建议您详细咨询相关领域专业人士。作者声明：本文系本人依照真实经历原创，未经许可，谢绝转载。