根据一览,自动生成Sheet页

根据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)

代码

猜你喜欢

转载自blog.csdn.net/sxzlc/article/details/83217700