Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2475|回复: 9

[已解决]生成工作簿

[复制链接]
发表于 2016-5-25 12:35 | 显示全部楼层 |阅读模式
本帖最后由 张雄友 于 2016-5-25 16:24 编辑

一个工作簿几千行,我想每三十行导出生成一个工作簿,每个工作簿都要有标题。标题是第一行!
最佳答案
2016-5-25 15:33
Sub test()
    Dim A, i, j, k, n, s, p$, f$

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    p = ThisWorkbook.Path & "\"
    n = 10    '每n行导出生成一个工作簿
    A = Range("a1").CurrentRegion

    For i = 2 To UBound(A) Step n    '遍历全部的起始行
        '1)赋值
        f = i \ n + 1
        s = 1
        For k = i To i + n - 1    '遍历n次
            If k <= UBound(A) Then    '如果在数组内
                s = s + 1
                For j = 1 To UBound(A, 2)
                    A(s, j) = A(k, j)
                Next j
            End If
        Next k

        '3)输出
        With Workbooks.Add
            .Sheets(1).[a1].Resize(s, j - 1) = A
            .SaveAs p & f
            .Close
        End With
    Next i

    MsgBox f, , "工作簿的个数"
End Sub

生成工作簿.rar (10.54 KB, 下载次数: 24)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2016-5-25 13:26 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2016-5-25 13:41 | 显示全部楼层
fjmxwrs 发表于 2016-5-25 13:26
老同志,新问题,不见附件

嗯。世态炎凉,电脑早就没网络了,手机上不了附件。就是:标准数据,第一行是标题,第二行以下是数据,共四列数据。
回复

使用道具 举报

发表于 2016-5-25 13:52 | 显示全部楼层
张雄友 发表于 2016-5-25 13:41
嗯。世态炎凉,电脑早就没网络了,手机上不了附件。就是:标准数据,第一行是标题,第二行以下是数据,共 ...

工作簿如何命名?
回复

使用道具 举报

 楼主| 发表于 2016-5-25 14:05 | 显示全部楼层
fjmxwrs 发表于 2016-5-25 13:52
工作簿如何命名?

1,2,3,………命名
回复

使用道具 举报

发表于 2016-5-25 15:33 | 显示全部楼层    本楼为最佳答案   
Sub test()
    Dim A, i, j, k, n, s, p$, f$

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    p = ThisWorkbook.Path & "\"
    n = 10    '每n行导出生成一个工作簿
    A = Range("a1").CurrentRegion

    For i = 2 To UBound(A) Step n    '遍历全部的起始行
        '1)赋值
        f = i \ n + 1
        s = 1
        For k = i To i + n - 1    '遍历n次
            If k <= UBound(A) Then    '如果在数组内
                s = s + 1
                For j = 1 To UBound(A, 2)
                    A(s, j) = A(k, j)
                Next j
            End If
        Next k

        '3)输出
        With Workbooks.Add
            .Sheets(1).[a1].Resize(s, j - 1) = A
            .SaveAs p & f
            .Close
        End With
    Next i

    MsgBox f, , "工作簿的个数"
End Sub

生成工作簿.rar (10.54 KB, 下载次数: 24)
回复

使用道具 举报

 楼主| 发表于 2016-5-25 16:20 | 显示全部楼层
爱疯 发表于 2016-5-25 15:33
Sub test()
    Dim A, i, j, k, n, s, p$, f$

我用辅助列完成了。
回复

使用道具 举报

发表于 2016-5-25 16:27 | 显示全部楼层
不知道你说的辅助列,是怎么做的
回复

使用道具 举报

 楼主| 发表于 2016-5-25 18:34 | 显示全部楼层
爱疯 发表于 2016-5-25 16:27
不知道你说的辅助列,是怎么做的

这手机回复太难了、已经重启
回复

使用道具 举报

发表于 2016-5-26 08:51 | 显示全部楼层
高手  高高手!!!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 19:29 , Processed in 0.361754 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表