2. 打开Visual Basic，添加模块和过程，称之为“建表拆数据”。
3. 添加新建工作表的代码，详细的步骤可以参考以下文章，这里将代码根据本案例的需求修改了一下。
Sub 建表拆数据()Dim sht As WorksheetDim i, j As Integer'建表For j = 2 To Sheet1.Range("A10000").End(xlUp).Rowi = 0For Each sht In SheetsIf sht.Name = Sheet1.Range("B" & j) Theni = 1End IfNextIf i = 0 ThenSheets.Add after:=Sheets(Sheets.Count)Sheets(Sheets.Count).Name = Sheet1.Range("B" & j)End IfNextEnd Sub
4. 进一步完善以上这段代码的可读性，可以定义一个变量krow为整数，且krow=Sheet1.Range("A10000").End(xlUp).Row，也就是数据总共的行数。Sub 建表拆数据()Dim sht As WorksheetDim i, j As IntegerDim krow As Integer '此为数据总行数'建表krow = Sheet1.Range("A10000").End(xlUp).RowFor j = 2 To krowi = 0For Each sht In SheetsIf sht.Name = Sheet1.Range("B" & j) Theni = 1End IfNextIf i = 0 ThenSheets.Add after:=Sheets(Sheets.Count)Sheets(Sheets.Count).Name = Sheet1.Range("B" & j)End IfNextEnd Sub
5. 添加筛选拆分数据的代码，详细的步骤可以参考以下文章，这里将代码根据本案例的需求修改了一下。
Sub 建表拆数据()Dim sht As WorksheetDim i, j, k As IntegerDim krow As Integer '此为数据总行数'建表krow = Sheet1.Range("A10000").End(xlUp).RowFor j = 2 To krowi = 0For Each sht In SheetsIf sht.Name = Sheet1.Range("B" & j) Theni = 1End IfNextIf i = 0 ThenSheets.Add after:=Sheets(Sheets.Count)Sheets(Sheets.Count).Name = Sheet1.Range("B" & j)End IfNext'拆分数据For k = 2 To Sheets.CountSheet1.Range("A1:F"&krow).AutoFilterField:=2,Criteria1:=Sheets(k).NameSheet1.Range("A1:F" & krow).Copy Sheets(k).Range("A1")NextSheet1.Range("A1:F" & krow).AutoFilterEnd Sub
6. 最后执行以上完整代码后，即可完成新建表和拆分数据的同步操作。以上示例只是用于演示，实际应用场景请根据自己的需要进行相应的设计或调整。已下架