【VBA案例004】自动填充表单

大家好！今天我们分享一个有关VBA自动填充表单的案例，帮助大家简化表单填写的过程，提高工作效率。

我们经常需要填写大量重复的表单，例如报销单、数据输入表格等，并且每个表单都有各自的字段需要填写。手动逐个填写这些表单既耗时又容易出错。

使用VBA自动填充表单可以极大地简化这一过程，让我们能够更专注于其他重要的工作。

譬如说，现在有两个表格，一个是人员清单，另一个的表单。

现在要做的是，将人员清单中的每一行信息，填到表单里，并导出为一个单独的工作簿。

下面是VBA的代码分享，你也可以观看下方的视频解析：

方法一：# 

Sub 表格填充()

    Dim i, j, k

    Dim xinXiSht As Worksheet
    Dim qingDanSht As Worksheet

    Set xinXiSht = ThisWorkbook.Worksheets("信息卡")
    Set qingDanSht = ThisWorkbook.Worksheets("人员清单")

    With qingDanSht
        For i = 2 To .Range("a" & .Rows.Count).End(xlUp).Row
            For j = 1 To 5
                xinXiSht.Range("c" & j + 4) = .Cells(i, j)
            Next j

            xinXiSht.Copy
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & .Range("a" & i) & ".xlsx"
            ActiveWorkbook.Close True
        Next i
    End With

End Sub

方法二：# 

Sub 表格填充优化()

    Dim i, j, k

    Dim xinXiSht As Worksheet
    Dim qingDanSht As Worksheet

    Set xinXiSht = ThisWorkbook.Worksheets("信息卡")
    Set qingDanSht = ThisWorkbook.Worksheets("人员清单")

    Application.ScreenUpdating = False

    Dim ar, br()
    With qingDanSht
        ar = .Range("a2:e" & .Range("a" & .Rows.Count).End(xlUp).Row)
        For i = 1 To UBound(ar)
            ReDim br(1 To 5, 1 To 1)
            For j = 1 To 5
                br(j, 1) = ar(i, j)
            Next j
            xinXiSht.[c5].Resize(UBound(br)) = br
            xinXiSht.Copy
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ar(i, 1) & ".xlsx"
            ActiveWorkbook.Close True
            xinXiSht.[c5:c9].ClearContents
        Next i
    End With

    Application.ScreenUpdating = True
End Sub

原始链接

目录: