运用VBA实现在Excel的3行3列的表单中填写1个1、2个2、3个3、3个4，使得每个数字在每行每列中都是唯一的。

ok~运行了十来秒才成功，貌似运气不行~下班了，来不及简化，再想想吧我~

代码如下

Sub aaa()aa: If Cells(6, 8).Value <> 18 Then

Dim a As Integer

Dim b As Integer

Dim c As Integer

a = WorksheetFunction.CountA(Range("a:a"))

c = 1

Do While c <= a

b = Int(Rnd * a) + 1

If Cells(b, 1).Value <> "" Then

Cells(b, 1).Select

Selection.Cut

Cells(c, 3).Select

ActiveSheet.Paste

c = c + 1

Else

End If

Loop

    Columns("C:C").Select

    Selection.Cut

    Range("A1").Select

    ActiveSheet.Paste

    Range("C1").Select

        Range("A1:A3").Select

    Selection.Copy

    Range("E3").Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

        False, Transpose:=True

    Range("A4:A6").Select

    Application.CutCopyMode = False

    Selection.Copy

    Range("E4").Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

        False, Transpose:=True

    Range("A7:A9").Select

    Application.CutCopyMode = False

    Selection.Copy

    Range("E5").Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

        False, Transpose:=True

    Range("E3:G5").Select

    Application.CutCopyMode = False

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    Range("C1").Select

    GoTo aa

Else

End Sub