根据一览，自动生成Sheet页

最新推荐文章于 2024-08-20 10:25:13 发布

sun0322

最新推荐文章于 2024-08-20 10:25:13 发布

阅读量1k

点赞数

分类专栏： # VBA

本文链接：https://blog.csdn.net/sxzlc/article/details/83217700

版权

VBA 专栏收录该内容

35 篇文章

订阅专栏

本文介绍了一种使用VBA宏在Excel中自动化创建Sheet页的方法，根据LISTSheet页中的工号批量生成新的Sheet页，并将人名信息填充至相应位置，最后删除模板Sheet页。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

根据Excel一览中的内容，自动生成一览名字中Sheet页

■画面效果

其中「000」sheet页为模板

根据「LIST」Sheet页一览中的工号，生成新的sheet页

可以把人名情报，填写到新的 sheet页中，执行完成后，删除模板「000」sheet页

■可以单独使用的代码


Public Sub createOutFileAllSheets()
 
    Dim peopleInfo As Object
    Set peopleInfo = CreateObject("Scripting.Dictionary")
    
    ActiveWorkbook.Sheets("LIST").Activate
    ActiveWorkbook.Sheets("LIST").Select
    
    Dim peopleName As String
    Dim peopleNumber As String
    
    For i = 3 To 100
    
        ActiveWorkbook.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
    
     GoTo endok
errl:
    'ERROR OPERATE
     ERROR_FLG = "1"
     'ERROR_INFO_LIST.Add ("method:createOutFileAllSheets:Exception")
     'ERROR_INFO_LIST.Add ("ERROR MESSAGE:" & Err.Number & "" & Err.Description)
endok:
 
 
End Sub

■运行后的效果

■以下代码为在工具中使用的一部分无法单独单独使用

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

'* * * * * * * * * * * * * * * * * * * *　* * * * * * * * *
'*                                    　　　　　　　　　  *
'* 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)

代码