今年年初我对游戏发展有两个设想，其中之一是把复杂规则的计算交给电脑来处理，以减轻天神的工作量并减少错误。在游戏20作了一次尝试，写了一个execl表格，用函数计算投标情况和中标者。成功之后，接下来我准备把猫命规则也做成execl表格。但开始设计之后才知道excel函数功能有限，很难演算出猫命的游戏进程。非用VBA不可。所以我开始学VBA编程。
昨晚完成了程序的第一部分：发牌
按7人、每人5张牌的游戏模式写的程序。这部分代码的设计是：
划定一个7*5的表格区域，每行对应1个玩家，每格对应1张牌。
区域中的每个单元格都有下拉框，其中列出本格可以选择的牌型供天神安放。
已经被分派光了的牌自动从下拉框中消去。
一个玩家已经有了的特权牌自动从这个玩家的单元格的下拉框中消去，但庶民牌不受影响。
杀手牌和狼人牌分配给同一个玩家的话将会提示错误。
如果一个玩家已经被分配了4张特权牌，程序自动把最后一张填充为庶民牌。
每分配了一张牌程序都会自动计算最新的情况。
Function KW(PlayerACards As Range) As Integer
'检查杀手牌和狼人牌是否发给了该玩家
KW = Application.WorksheetFunction.CountIf(PlayerACards, "杀手") + Application.WorksheetFunction.CountIf(PlayerACards, "狼人")
End Function
Sub AutoWriteCivilian(PlayerACards As Range)
'如果已经分配给该玩家4张牌且没有庶民牌，则自动分配给玩家1张庶民牌
If Application.WorksheetFunction.CountIf(PlayerACards, "") = 1 And Application.WorksheetFunction.CountIf(PlayerACards, "庶民") = 0 Then
'查找最后一个空白单元格并写入“庶民”
For Each cell In PlayerACards.Cells
If cell.Value = "" Then
cell.Select
ActiveCell.Value = "庶民"
Exit For
End If
Next cell
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'声明变量StartRow、CurrentPlayer和UndealCol，用于指定可分配牌型列表所在区域的位置
Dim StartRow As Integer
Dim CurrentPlayer As Integer
Dim UndealCol As Integer
'给StartRow赋值
StartRow = 30
'声明7位玩家各自的持牌情况区域
Dim Player1Cards As Range
Dim Player2Cards As Range
Dim Player3Cards As Range
Dim Player4Cards As Range
Dim Player5Cards As Range
Dim Player6Cards As Range
Dim Player7Cards As Range
Set Player1Cards = Worksheets("日程").Range("$D$30:$H$30")
Set Player2Cards = Worksheets("日程").Range("$D$31:$H$31")
Set Player3Cards = Worksheets("日程").Range("$D$32:$H$32")
Set Player4Cards = Worksheets("日程").Range("$D$33:$H$33")
Set Player5Cards = Worksheets("日程").Range("$D$34:$H$34")
Set Player6Cards = Worksheets("日程").Range("$D$35:$H$35")
Set Player7Cards = Worksheets("日程").Range("$D$36:$H$36")
'声明对象DealtCards，指定表格中用于记录玩家的持牌情况的区域
Dim DealtCards As Range
Set DealtCards = Union(Player1Cards, Player2Cards, Player3Cards, Player4Cards, Player5Cards, Player6Cards, Player7Cards)
'声明对象UndealCards，指定表格中用于记录可分配牌型的区域
Dim UndealCards As Range
Set UndealCards = Worksheets("日程").Range("$CW$30:$DI$36")
'指定触发本过程的单元格范围
If Target.column <= 8 And Target.column >= 4 And Target.row <= 36 And Target.row >= 30 Then
'清空记录可分配牌型的区域
UndealCards.Select
Selection.ClearContents
'声明变量CardCount，记录这一牌型被分配了几张
Dim CardCount As Integer
'声明变量CardName，记录这一牌型的名称
Dim CardName As String
'循环检查7位玩家的可分配牌型
For CurrentPlayer = StartRow To StartRow + 6
'初始化undealcol
UndealCol = 101
'循环检查13种牌型
For i = 2 To 14
'给cardname变量赋值
CardName = Worksheets("常量").Cells(i, 1).Value
'调用Excel内置函数countif，统计该牌型已经一共被分配了几张
CardCount = Application.WorksheetFunction.CountIf(DealtCards, CardName)
'声明对象mycards，指定表格中记录该玩家已分到的牌型的区域
Dim mycards As Range
Set mycards = Rows(CurrentPlayer)
'声明变量MyCardCount，记录这一牌型是否已分配给该玩家
Dim MyCardCount As Integer
'调用Excel内置函数countif，统计该牌型是否曾被分配给该玩家
MyCardCount = Application.WorksheetFunction.CountIf(mycards, CardName)
'庶民牌不管是否已经分配给该玩家，都不统计（庶民牌可以重复分配）
If CardName = "庶民" Then
MyCardCount = 0
End If
'循环查找可分配牌型列表所在区域的第一个空白单元格
Do While Worksheets("日程").Cells(CurrentPlayer, UndealCol).Value <> ""
UndealCol = UndealCol + 1
Loop
'如果该牌型还没有被分配光，而且还没有被分配给该玩家过，就把该牌型写入可分配的牌型列表之中第一个空白单元格
If CardCount < Worksheets("常量").Cells(i, 2).Value And MyCardCount = 0 Then
Debug.Print CardName
Worksheets("日程").Cells(CurrentPlayer, UndealCol).Value = CardName
End If
Next i
Next CurrentPlayer
'循环查找记录玩家的持牌情况的区域的下一个空白单元格并把光标移动到该单元格以供下一次输入
For Each cell In DealtCards.Cells
If cell.Value = "" Then
cell.Select
Exit For
End If
Next cell
'声明变量KWError，记录指定区域中的杀手牌和狼人牌共有几张
Dim KWError As Integer
'调用KW函数检查是否把杀手牌和狼人牌分配给了同一个玩家
KWError = KW(Player1Cards)
If KWError = 2 Then
MsgBox ("杀手牌和狼人牌不能分配给同一个玩家！请修改！")
End If
KWError = KW(Player2Cards)
If KWError = 2 Then
MsgBox ("杀手牌和狼人牌不能分配给同一个玩家！请修改！")
End If
KWError = KW(Player3Cards)
If KWError = 2 Then
MsgBox ("杀手牌和狼人牌不能分配给同一个玩家！请修改！")
End If
KWError = KW(Player4Cards)
If KWError = 2 Then
MsgBox ("杀手牌和狼人牌不能分配给同一个玩家！请修改！")
End If
KWError = KW(Player5Cards)
If KWError = 2 Then
MsgBox ("杀手牌和狼人牌不能分配给同一个玩家！请修改！")
End If
KWError = KW(Player6Cards)
If KWError = 2 Then
MsgBox ("杀手牌和狼人牌不能分配给同一个玩家！请修改！")
End If
KWError = KW(Player7Cards)
If KWError = 2 Then
MsgBox ("杀手牌和狼人牌不能分配给同一个玩家！请修改！")
End If
'分配了4张特权牌后，调用AutoWriteCivilian过程自动分配给该玩家一张庶民牌
Call AutoWriteCivilian(Player1Cards)
Call AutoWriteCivilian(Player2Cards)
Call AutoWriteCivilian(Player3Cards)
Call AutoWriteCivilian(Player4Cards)
Call AutoWriteCivilian(Player5Cards)
Call AutoWriteCivilian(Player6Cards)
Call AutoWriteCivilian(Player7Cards)
'声明变量EmptyCells，记录一个区域中空格单元格的数目
Dim EmptyCells As Integer
'检查记录玩家的持牌情况的区域中是否还有空格
EmptyCells = Application.WorksheetFunction.CountIf(DealtCards, "")
'选中记录玩家的持牌情况的区域并提示所有牌已经分配完毕
If EmptyCells = 0 Then
DealtCards.Select
MsgBox ("所有牌都已经被分配")
End If
End If
End Sub
