Excel教程:用VBA批量制作职工信息档案卡

本文为《别怕,Excel VBA其实特别简单(第3版)》随书问题参考答案

解决问题的过程可以写为:

Sub 生成档案卡文件()

Application.ScreenUpdating = False

Dim Irow As Long, Sht As Worksheet

Set Sht = ThisWorkbook.Worksheets("档案信息")

For Irow = 2 To Sht.UsedRange.Rows.Count

With ThisWorkbook.Worksheets("档案卡")

.Range("C4:E4").Value = Sht.Range("A" & Irow & ":C" & Irow).Value

.Range("C7:E7").Value = Sht.Range("D" & Irow & ":F" & Irow).Value

.Range("C10").Value = "'" & Sht.Cells(Irow, "G").Value

.Range("E10").Value = Sht.Cells(Irow, "H").Value

.Range("C13:E13").Value = Sht.Range("I" & Irow & ":K" & Irow).Value

.Range("C16").Value = Sht.Cells(Irow, "L").Value

End With

ThisWorkbook.Worksheets("档案卡").Copy

ActiveSheet.Name = Sht.Cells(Irow, "A").Value

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Sht.Cells(Irow, "A").Value & ".xlsx"

ActiveWorkbook.Close

Next Irow

ThisWorkbook.Worksheets("档案卡").Range("C4:E4,C7:E7,C10:E10,C13:E13,C16").Value = ""

Application.ScreenUpdating = True

MsgBox "操作完成,单击【确定】按钮查看结果。", vbInformation

Shell "explorer.exe " & ThisWorkbook.Path & "\", vbNormalFocus

End Sub

AI助手