案例

案例來源：Excel和Access （微信公眾號）點擊 - 查看原文

示例圖一

根據源數據，制作帶空行或者不帶空行的工資條。

附件：點擊查看-百度云
提取密碼：uvvo

一、數據源代碼

Sub 源數據代碼()
    '錄入數據
    Cells(1, 1) = "員工號"
    Cells(1, 2) = "姓名"
    Cells(1, 3) = "部門"
    Cells(1, 4) = "工資"
    Cells(1, 5) = "獎金"
    Cells(1, 6) = "應發(fā)工資"
    
    Cells(2, 1) = "A12"
    Cells(2, 2) = "甲"
    Cells(2, 3) = "技術部"
    Cells(2, 4) = "3600"
    Cells(2, 5) = "700"
    Cells(2, 6) = "4300"
    
    Cells(3, 1) = "A13"
    Cells(3, 2) = "乙"
    Cells(3, 3) = "開發(fā)部"
    Cells(3, 4) = "3100"
    Cells(3, 5) = "800"
    Cells(3, 6) = "3900"
    
    Cells(4, 1) = "A14"
    Cells(4, 2) = "丙"
    Cells(4, 3) = "發(fā)展部"
    Cells(4, 4) = "2900"
    Cells(4, 5) = "900"
    Cells(4, 6) = "3800"
    
    Cells(5, 1) = "A15"
    Cells(5, 2) = "丁"
    Cells(5, 3) = "銷售部"
    Cells(5, 4) = "2200"
    Cells(5, 5) = "400"
    Cells(5, 6) = "2600"

    Cells(6, 1) = "A16"
    Cells(6, 2) = "戊"
    Cells(6, 3) = "綜合部"
    Cells(6, 4) = "2900"
    Cells(6, 5) = "500"
    Cells(6, 6) = "3400"
    
    '格式調整
    With Range("a1:f6")
        .Borders.LineStyle = 1
        .HorizontalAlignment = xlCenter
    End With
    With Range("a1:f1")
        .Font.Bold = True
        .Interior.ColorIndex = 15
    End With
    ActiveWindow.DisplayGridlines = False '設置網格線
End Sub

.Interior.Colorindex = 15 , 表示設置單元格的背景顏色-灰色

二、制作不帶空行的工資條

Sub 示例制作不帶空行工資條()
Dim I, K, M As Integer

K = InputBox("請輸入工資條起始行號，該行號要大于已有工資表數據的行號!", "提示")

If K < Range("a1").End(xlDown).Row Then
    MsgBox "您輸入的起始行號過少，將會造成錯誤，請重新輸入！", vbCritical, "警告"
Exit Sub
End If

For I = 2 To Range("a1").End(xlDown).Row
    Range("a1:f1").Copy Destination:=Range("a" & K + 2 * M)
    Range("a" & I & ":f" & I).Copy Destination:=Range("a" & K + 1 + 2 * M)
    M = M + 1
Next
'利用m循環(huán)增加工資條位置，2*M表示每次循環(huán)，工資條向下位移2個位置；3*M表示每次循環(huán)，工資條向下位移3個位置，帶空行
End Sub

2.1 For循環(huán)，利用源數據工資表的最后一行行號
2.2 利用M，做每次工資條位置的變化

三、制作帶空行的工資條

Sub 示例制作帶空行工資條()
Dim I, K, M As Integer

K = InputBox("請輸入工資條起始行號，該行號要大于已有工資表數據的行號!", "提示")

If K < Range("a1").End(xlDown).Row Then
    MsgBox "您輸入的起始行號過少，將會造成錯誤，請重新輸入！", vbCritical, "警告"
Exit Sub
End If

For I = 2 To Range("a1").End(xlDown).Row
    Range("a1:f1").Copy Destination:=Range("a" & K + 3 * M)
    Range("a" & I & ":f" & I).Copy Destination:=Range("a" & K + 1 + 3 * M)
    M = M + 1
Next
End Sub

• 與不帶空行的區(qū)別，是在調用m的時候，通過每次增加3行變量，其中帶值2行，空1行。

自制工資條代碼

Sub 自制工資條()
Dim BiaoTi As Ranges
Dim d As Long
Dim I, x As Integer

'自適應獲取excel行數
Range("a1").EntireColumn.Insert shift:=xlShiftToRight
d = Range("a:a").End(xlDown).Row
Range("a1").EntireColumn.Delete shift:=xlShiftToLeft

x = Range("a" & d).End(xlUp).Row

For I = 2 To x
    Range("1:1").Copy Range("a" & Range("a" & d).End(xlUp).Row + 2)
    Rows(I).Copy Range("a" & Range("a" & d).End(xlUp).Row + 1)
Next


End Sub

自制工資條，通過插入新列-統(tǒng)計表格行數-刪除新列，得到一個固定的A列最底的單元格。
工資條是否空行，在第一個復制的地方，.Row+1不空行；.Row+2空行。