在工作表上右键,查看代码,将下面的代码复制入其中(当前sheet的代码窗),
设置其中的两个变量(看代码中的注释),返回sheet表,改动"点数"试试吧:
------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, rng As Range, n
With ActiveSheet
Set c = .Range("F2") '点数 单元格 '此处预先设置
Set rng = .Range("B2:D2") '加行的 标题行位置 '此处预先设置
Set c = Application.Intersect(c, Target)
If c Is Nothing Then Exit Sub
c.Select
If Not IsNumeric(c.Value) Then
MsgBox "点数单元格" & c.Address(0, 0) & " 内不是数字", vbCritical
Exit Sub
End If
n = Int(c.Value)
If n < 1 Then
MsgBox "点数要 大于1 ", vbCritical
Exit Sub
End If
Application.EnableEvents = False
With rng.Offset(1).Resize(n)
.Resize(65536 - .Row).Clear
.Borders.LineStyle = xlContinuous
.Interior.Color = RGB(220, 230, 240)
With .Cells(1, 1)
.Value = 1
.AutoFill .Resize(n), xlFillSeries
End With
.Select
End With
Application.EnableEvents = True
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim i
If Target.Address = "$B$2" Then
Range("D2:F10000").Cells.Clear
For i = 1 To Target.Value
Cells(i + 1, 4) = i
With Range(Cells(i + 1, 4), Cells(i + 1, 6)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599963377788629
.PatternTintAndShade = 0
End With
Next
With Range("D1:F" & Range("D65536").End(xlUp).Row)
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
End If
End Sub