根据sheet1数据自动生成N个表2

乐彩007

表2，只有两个变量，编号和验收部位，求大神帮忙，用相对简单的方法实现，十分感谢！！！！

3190496160

Sub 新建工作表()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("单元号")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "单元号工作表为空，请先导入数据！": End
    ar = .Range("a1:b" & r)
End With
For Each sh In Sheets
    If sh.Index > 2 Then
        d(sh.Name) = ""
    End If
Next sh
For i = 2 To UBound(ar)
    If ar(i, 1) <> "" And ar(i, 2) <> "" Then
        s = ar(i, 1) & "|" & ar(i, 2)
        If Not d.exists(s) Then
            Sheets("模板").Copy after:=Sheets(Sheets.Count)
            With ActiveSheet
                .Name = s
                .[z4] = ar(i, 1)
                .[f7] = ar(i, 2)
            End With
        End If
    End If
Next i
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

乐彩007

表比较大，希望大神帮我秒杀这个难题，

乐彩007

大神来了，我知道，小白我在这先谢过了！

edwin11891

文件下载几次，大小全是0KB。

乐彩007

edwin11891 发表于 2024-11-25 21:32
文件下载几次，大小全是0KB。

不好意思，我重新 上传
谢谢大神

乐彩007

请大神查收

乐彩007

请大神查收

edwin11891

这个最好用VBA，填空后每项生成一张表，建议转移到VBA板块求教。

函数不能创建新表，只能在同一张表内重复，由于还有插入图件，函数太麻烦。

乐彩007

edwin11891 发表于 2024-11-25 21:43
这个最好用VBA，填空后每项生成一张表，建议转移到VBA板块求教。

函数不能创建新表，只能在同一张表内重 ...

谢谢
我会去求教

乐彩007

edwin11891 发表于 2024-11-25 21:43
这个最好用VBA，填空后每项生成一张表，建议转移到VBA板块求教。

函数不能创建新表，只能在同一张表内重 ...

这里有一个VBA，可是年头太多了，我也不会用了