应坛友水若善的需求,给大家一段VBA程序,猜猜这个是干什么用的?
给大家一段代码,猜猜这个是干什么用的?
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next '当程序出错时候,继续执行下一句
Arr = [A1].CurrentRegion
For i = 4 To UBound(Arr)
Sheets("sheet2").Copy
With ActiveWorkbook.Sheets(1)
.[B2] = Trim(Arr(i, 3))
.[D2] = Arr(i, 2)
.[B3] = Arr(i, 6) & "人"
.[D3] = Arr(i, 5)
.[D5].Resize(13, 1) = Application.Transpose(Application.Index(Array(Arr(i, 7), Arr(i, 8), Arr(i, 9), Arr(i, 10), Arr(i, 11), Arr(i, 12), Arr(i, 13), Arr(i, 14), Arr(i, 15), Arr(i, 16), Arr(i, 17), Arr(i, 18), Arr(i, 19)), 0))
End With
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Trim(Arr(i, 3)) & "(" & Arr(i, 5) & ")" & ThisWorkbook.Name & ".xls"
'ActiveWorkbook.PrintOut
ActiveWorkbook.Close
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
代码给大家,有兴趣地测试下,还原数据模型。
温馨提示:这段代码没有在以往我发布的帖子出现,代码虽简短,但是实现的功能非常强大!