Excel情头大作战：生成个性二次元专属昵称

*实例*

模拟器演示

B和C列支持10000条数据的输入和替换

可记录多次测试结果

步骤一：界面设计

单元格B：C区域，输入“妹子编号”数据，并为其分配自增的不重复编号（1-10003）

单元格L列，为【结束】后保存之前的抽女友结果，点击【重置】按钮，将清除E3：I7摇奖区域和L列的数据

步骤二：EXCEL VBA代码

==================开始===================

'设定控制结束的布尔值

Dim isScroll As Boolean

Dim arr1 As Variant

Dim arr2 As Variant

Dim arrName As Variant

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'生成x个不重复的随机数

Sub rollXnum()

Dim k As Long

Dim x As Integer

x = Application.WorksheetFunction.Max(Range("B3:B10003").Value)

ReDim arr1(1 To x), arr2(1 To x), arrName(1 To x)

Do

k = Int(Rnd() * x + 1)

If arr2(k) = "" Then

arr2(k) = k

m = m + 1

arr1(m) = k

arrName(m) = Cells(2 + m, 3).Value

' Range("A" & m + 2).Value = arr1(m)

' Debug.Print arr1(m)

Loop Until m = x

Sub main()

isScroll = False

Application.ScreenUpdating = False

Call rollXnum

Dim x As Integer, y As Integer, z As Integer

' Cells(3, 5).Value = "test"

For x = 1 To 5 Step 1

For y = 1 To 5 Step 1

z = arr1(5 * (y - 1) + x)

Cells(2 + y, 4 + x).Value = arrName(z)

Next

Next

Dim m As Integer, n As Integer

Randomize

m = Int(Rnd() * (7 - 3 + 1) + 3) 'y轴

n = Int(Rnd() * (9 - 5 + 1) + 5) 'x轴

Range("E3:I7").Interior.ColorIndex = xlNone

Cells(m, n).Interior.Color = RGB(Int(Rnd() * 255), Int(Rnd() * 255), Int(Rnd() * 255)) '随机填充颜色

Application.ScreenUpdating = True

DoEvents '释放程序控制权，允许其他。。

Sleep (300) '延时ms

DoEvents '释放程序控制权，允许其他。。

Dim b As Integer

b = Range("K1").Value

If isScroll = True Then

b = b + 1

Range("K1").Value = b

Range("K" & b + 2).Value = b

Range("L" & b + 2).Value = Cells(m, n).Value

Exit Sub '判断控制结束的标记是否为true，是就跳出sub

Call main

Sub gameover()

isScroll = True '将控制结束的标记置为true

'重置摇奖区和结果展示区数据

Sub resetGame()

Range("k1").ClearContents

Range("k3:K10003").ClearContents

Range("L3:L10003").ClearContents

Range("E3:I7").Interior.Color = RGB(255, 255, 255)

Range("E3:I7").Value = ""

==================结束===================

封面