VBA根据名称拆分表格

coco122222

我想根据名称列里的名称拆分 成文以名称名 命名的表格，总表要求还在的。

有了总表和分表后，在把分表分别另存为工作簿
有老师帮忙写个代码吗
数据量是很大的有很多很多很多很多行

3190496160

【新提醒】灵活拆分工具之三-Excel VBA程序开发-ExcelHome技术论坛 -  https://club.excelhome.net/thread-1535151-1-1.html

fzxba

根据名称列里的名称拆分表格.rar (56.43 KB, 下载次数: 22)

2023-1-10 07:42 上传

点击文件名下载附件

liulang0808

Sub test()
    Set d = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each sh In Sheets
        If sh.Name <> "总表" Then
            sh.Delete
        End If
    Next sh
    Set sh = Sheets("总表")
    arr = sh.UsedRange
    sh.Select
    For j = 2 To UBound(arr)
        If Len(arr(j, 7)) > 0 Then
            If d.exists(arr(j, 7)) Then
                Set d(arr(j, 7)) = Union(Cells(j, 1), d(arr(j, 7)))
            Else
                Set d(arr(j, 7)) = Union(Cells(j, 1), [a1])
            End If
        End If
    Next j
    For Each k In d.keys
        sh.Copy after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).UsedRange.Clear
        Sheets(Sheets.Count).Name = k
        d(k).EntireRow.Copy Sheets(Sheets.Count).[a1]
        Sheets(Sheets.Count).Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & k & ".xlsx"
        ActiveWorkbook.Close True
    Next k
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

liulang0808

供参考。。。。。。

ykcbf1100

参与一下。

总表拆分。

LIUZHU

在JS中也是一个经典案例，凑个热闹

LIUZHU

附件在此，WPS测试

LIUZHU

题目的要求时，还要另存为独立的工作簿，更新下

sunya_0529

LIUZHU 发表于 2023-1-10 09:10
在JS中也是一个经典案例，凑个热闹

借着 @LIUZHU 老师的这段代码，学习了一下JSA，跟VBA对比，还是有蛮多收获的。

• JSA中，数组的功能比VBA中高级太多，如上图中①所示，这段如果用VBA的话就是数组+字典，很难用如此简洁的几句代码实现同样的功能；
• 在VBA中“With……End With”语句，在JSA中也有类似用法，可以省去很多代码，缺点是没有智能提示了，所有的属性和方法必须手工敲对；（如②所示）
• 在@LIUZHU 老师的代码中看到②中用数组集体赋值的方式，顿时被惊艳到了
• 在删除工作表代码中，习惯VBA中用遍历的方式去处理，发现“Delete()”放在循环体内无法正常运行，试着用上图③中所示的方法，运行成功了，搞不清楚原因
• 习惯写VBA后，JS代码里的“；”老是忘了写，貌似在JSA中，不写也不影响；
• 对象的属性和方法真的要特别注意大小写（查看了官方文档，属性值写错是没有错误提示的），貌似数组对象的属性和方法都是小写（其他的未验证）；
• 看官方文档说“Value”和“Value2”的区别是前可只读，后者可读写。但是在将单元格区域赋值给二维数组时，必须用“Value2”，好奇怪~