|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 生成台账()
Application.ScreenUpdating = False
Dim cr()
Application.DisplayAlerts = False
For Each sh In Sheets
If sh.Index > 3 Then
sh.Delete
End If
Next sh
Application.DisplayAlerts = True
ar = Sheets("花名册").[a1].CurrentRegion
br = Sheets("培训内容").[a1].CurrentRegion
For i = 2 To UBound(ar)
If Trim(ar(i, 4)) <> "" Then
n = 0
ReDim cr(1 To UBound(br), 1 To UBound(br, 2))
For s = 2 To UBound(br)
If Trim(br(s, 1)) = Trim(ar(i, 6)) Or Trim(br(s, 1)) = "ALL" Then
n = n + 1
For j = 2 To UBound(br, 2)
cr(n, j - 1) = br(s, j)
Next j
End If
Next s
Sheets("模板").Copy after:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Name = ar(i, 4)
.[b3] = ar(i, 6)
.[d3] = ar(i, 4)
.[a6].Resize(n, UBound(cr, 2)) = cr
End With
End If
Next i
Application.ScreenUpdating = True
End Sub
|
评分
-
1
查看全部评分
-
|