Sub make_wage() Debug.Print ("=====================================================") ' 先把整个工资表个copy过来 Cells.Select Selection.copy Sheets("工资条").Select Cells.Select ActiveSheet.Paste ' 不管发生什么错误都继续执行 On Error Resume Next 'XRan 酱油的 把总共多少行计算出来 'YRan 表头 'ZRan 间隔行 Dim XRan As Range,YRan As Range,ZRan As Range,RowNum As Integer,i As Integer Dim Down,N '标题行数 Down = MsgBox("工资表表头是否设计好?" & vbCrLf & " " & vbCrLf & "★表头将直接套用到工资条中★",vbQuestion + vbYesNo,"功能提示") If Down = vbNo Then Sheets("工资表").Select Range("A1:C1").Select Exit Sub End If Down = MsgBox("是否制作工资条?","功能提示") If Down = vbNo Then Sheets("工资表").Select Range("A1:C1").Select Exit Sub End If '指定标题的列数 ' Do loop 是如果不满足 就一直给循环下去 满足后运行loop Do N = InputBox("请指定表头行数!" & vbCrLf & " " & vbCrLf & "“确定”后依数据量耐心等候…………","提示",1) If IsNumeric(N) Then Exit Do Else Down = MsgBox("给定为非整数!!" & vbCrLf & "是否重新指定?",vbExclamation + vbYesNo,"错误") If Down = vbNo Then Sheets("工资表").Select Range("A1:C1").Select Exit Sub End If End If Loop N = CInt(N) '先按标题数N插入N+1行空行 Set XRan = Cells(N + 1,2) 'B列要确保为非空列 Do '这一句不懂 但是 这一段代码就是没一行之间都插入 N+1个空格 XRan.Offset(1,0).Rows("1:" & N + 1).EntireRow.Insert Shift:=xlDown Set XRan = XRan.End(xlDown) RowNum = ActiveSheet.UsedRange.Rows.Count Debug.Print ("XRan.Row ==" & XRan.Row) Debug.Print ("RowNum == " & RowNum) Loop While XRan.Row < RowNum '再复制标题列 RowNum = ActiveSheet.UsedRange.Rows.Count Rows("1:" & N).Select Selection.copy Set YRan = Rows(N + 3 & ":" & 2 * N + 2) ' i = 那个数 然后 最大数 为 RowNum 每一次的跨度是 N+2 For i = 2 * (N + 2) + 1 To RowNum Step N + 2 Set YRan = Union(YRan,Rows(i & ":" & i + N - 1)) Next YRan.Select Debug.Print ("RowNum2222 == " & RowNum) ActiveSheet.Paste '最后设定好数据间的距离 Set ZRan = Rows(N + 2) For i = 2 * (N + 2) To RowNum Step N + 2 Set ZRan = Union(ZRan,Rows(i)) Next ZRan.Select Selection.Borders.Linestyle = xlNone ' Do nothing Down = MsgBox("是否指定工资条间距?" & vbCrLf & " " & vbCrLf & "★打印前应预览有无跨页★","间距") If Down = vbYes Then Do N = InputBox("请指定工资条间距!" & vbCrLf & " " & vbCrLf & "可通过调整间距或页边距使工资条不跨页",20) If IsNumeric(N) Then If N >= 0 And N <= 409 Then Exit Do End If End If Down = MsgBox("行高必须在0至409之间!" & vbCrLf & "是否重新指定?","错误") If Down = vbNo Then Exit Sub End If Loop Selection.RowHeight = N End If End Sub