根据Excel一览中的内容,自动生成一览名字中Sheet页
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'* *
'* Out対象の全員シート作成 *
'* 作成日:2017/08/13 *
'* 作成者:sun *
'* 更新日:2017/08/13 *
'* 更新者:sun *
'* *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Public Sub createOutFileAllSheets(outWb As Workbook)
On Error GoTo errl
'★★★Operate Out ファイル step1 start★★★
outWb.Activate
outWb.Sheets("LIST").Select
Dim peopleName As String
Dim peopleNumber As String
For i = 3 To 100
outWb.Sheets("LIST").Select
peopleName = Cells(i, 3).Value
peopleNumber = Cells(i, 2).Value
If peopleName = Empty Then
Exit For
End If
Sheets("000").Copy After:=Sheets(2 + (i - 3))
Sheets("000 (2)").Name = peopleNumber
Sheets(peopleNumber).Select
Range("C3").Value = peopleName
'KEY:peopleName, Value:peopleNumber
peopleInfo.Add peopleName, peopleNumber
Next
Sheets("000").Select
ActiveWindow.SelectedSheets.Delete
'★★★Operate Out ファイル step1 end★★★
GoTo endok
errl:
'異常処理
ERROR_FLG = "1"
ERROR_INFO_LIST.Add ("関数「createOutFileAllSheets」で、エラー発生しました。")
ERROR_INFO_LIST.Add ("エラー詳細:" & Err.Number & " : " & Err.Description)
endok:
End Sub
调用元相关
'IN対象ファイル
Dim wbIn As Workbook
'IN対象ファイル、File毎にOpen
Application.DisplayAlerts = False
Set wbIn = Workbooks.Open(IN_FILE_PATH & "\" & IN_FILE1_NAME, UpdateLinks:=0, ReadOnly:=True)
代码