用VBA编制羽毛球比赛赛程

125675117

[backcolor=rgba(255, 255, 255, 0.86)]用于生成羽毛球比赛的赛程表。假设有3个组别，每个组别有4支队伍，比赛采用单循环制，共进行3轮比赛。

[backcolor=rgba(255, 255, 255, 0.86)]但是代码报错-缺少数组，请见附件。

liulang0808

建议增加参赛信息在表格内，然后再对数据进行处理。

边缘码农

字符型变量，不是数组。

边缘码农

数组可以这样用？

边缘码农

运行结果：

边缘码农

1. 'Option Explicit
   
2. Sub Generate羽毛球比赛赛程表()
   
3.     Dim teamNames As String, i As Integer, j As Integer, k As Integer
   
4.     Dim matchDay As Integer, matchTime As String, matchTeam1 As String, matchTeam2 As String
   
5.     Dim matchResult As String, matchWinner As String
   
6.    
   
7.     '输入参赛队伍名称
   
8.     teamNames = InputBox("请输入参赛队伍名称(用空格分隔):")
   
9.    
   
10.     '将队伍名称转换为数组
    
11.     Dim teamArray() As String
    
12.     teamArray = Split(teamNames, " ")
    
13.     Dim teamArrayLength As Integer
    
14.     teamArrayLength = UBound(teamArray) + 1
    
15.     '计算每轮比赛的场次和对手匹配情况
    
16.     Dim roundCount As Integer, roundMatchCount As Integer
    
17.     roundCount = 3
    
18.     roundMatchCount = Int((teamArrayLength - 1) * (teamArrayLength - 2) / 2)
    
19.    
    
20.     '生成第一轮比赛的赛程表
    
21.     k = 0
    
22.     For i = 0 To UBound(teamArray)
    
23.         For j = i + 1 To UBound(teamArray)
    
24.             If teamArray(i) <> teamArray(j) Then
    
25.                 matchDay = Int((i + j) * (i + j + 1) / 2) + k + 1
    
26.                 matchTime = "9:00" & matchDay & " AM"
    
27.                 matchTeam1 = teamArray(i) & " vs " & teamArray(j)
    
28.                 matchTeam2 = teamArray(j) & " vs " & teamArray(i)
    
29.                 matchResult = ""
    
30.                 matchWinner = teamArray(i)
    
31.                
    
32.                 '检查是否已经进行了类似的比赛
    
33.                 For l = k + 1 To roundMatchCount
    
34.                     If matchTeam1 = teamArray(l Mod teamArrayLength) And matchTeam2 = teamArray((l \ teamArrayLength) Mod teamArrayLength) Then
    
35.                         matchResult = "T" & l \ roundMatchCount & "" & teamArray(l Mod teamArrayLength) & _
    
36.                             " vs " & teamArray((l \ teamArrayLength) Mod teamArrayLength) & "" & matchWinner _
    
37.                             & "" & matchResult & "" & matchWinner & "" & matchResult & "" & matchWinner & "" _
    
38.                             & matchResult & "" & matchWinner & "" & matchResult & "" & matchWinner & "" & matchResult & "" _
    
39.                             & matchWinner & "" & matchResult & "" & matchWinner & "" & matchResult & "" & matchWinner & "" _
    
40.                             & matchResult & "" & matchWinner & "" & matchResult & "" & matchWinner & "" & matchResult & "" _
    
41.                             & matchWinner & "" & matchResult & "" & matchWinner & "" & matchResult & ""
    
42.                         Exit For
    
43.                     End If
    
44.                 Next l
    
45.                
    
46.                 '输出比赛信息到Excel表格中
    
47.                 Worksheets("Match Schedule").Cells(matchDay, 2).Value = matchTime
    
48.                 Worksheets("Match Schedule").Cells(matchDay, 3).Value = matchTeam1
    
49.                 Worksheets("Match Schedule").Cells(matchDay, 4).Value = matchTeam2
    
50.                 Worksheets("Match Schedule").Cells(matchDay, 5).Value = matchResult
    
51.                 Worksheets("Match Schedule").Cells(matchDay, 6).Value = matchWinner
    
52.                 k = k + 1
    
53.             End If
    
54.         Next j
    
55.         k = k + 1
    
56.     Next i
    
57.    
    
58.     '输出第一轮比赛的赛程表到Excel表格中
    
59.     MsgBox Worksheets("Match Schedule").Range("A1").CurrentRegion.Address, _
    
60.         vbInformation, "第一轮比赛赛程表"
    
61. End Sub
    
62. 
    
63. 
    

复制代码

边缘码农

羽毛球赛程.rar (19.5 KB, 下载次数: 13)

2023-5-31 12:18 上传

点击文件名下载附件

贴代码审核比较慢。

zpy2

http://anyoupin.cn/bisai/

单循环可以参谋一下

125675117

边缘码农 发表于 2023-5-31 12:19
贴代码审核比较慢。

谢谢老师，对比了代码，看到修改了一小部分，已经能正常运行。

micch

是练习还是实际应用。我之前做过羽毛球比赛，不过做的不是很理想，一直想重做一次。