文件拆分，数据量较大，求大神帮忙！！！

powerremain

每一组数据的第一行不要，仅作为文件夹和文件名称使用。

每一组数据的c列数字是文件夹的名称，改为：包（对应数字），每一组的数据B列是文件名称。
c列相同数字的放入对应数字文件夹。
求各位大神来个速度快点的方法。

ykcbf1100

原格式拆分为多工作簿

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.16
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim zrr(1 To 1000)
   
5.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
6.     Sheets("分类明细总表").Activate
   
7.     r = Cells(Rows.Count, 1).End(3).Row
   
8.     p = ThisWorkbook.Path & ""
   
9.     For i = 1 To r
   
10.         If InStr(Cells(i, 1), "物资名称") Then
    
11.             m = m + 1
    
12.             zrr(m) = Array(i, i)
    
13.         End If
    
14.         If i = r Then zrr(m)(1) = r
    
15.         If InStr(Cells(i + 1, 1), "物资名称") Then zrr(m)(1) = i
    
16.     Next
    
17.     For x = 1 To m
    
18.         fn = Cells(zrr(x)(0), 2)
    
19.         st = Split(Cells(zrr(x)(0) + 3, 1), "：")(1)
    
20.         p1 = p & "包（" & st & "）"
    
21.         If Not Fso.FolderExists(p1) Then Fso.CreateFolder p1
    
22.         Set Rng = Cells(zrr(x)(0) + 1, 1).Resize(zrr(x)(1) - zrr(x)(0), 9)
    
23.         Application.SheetsInNewWorkbook = 1
    
24.         Set wb = Workbooks.Add
    
25.         Rng.Copy
    
26.         wb.Sheets(1).Select
    
27.         [a1].PasteSpecial Paste:=xlPasteColumnWidths
    
28.         ActiveSheet.Paste
    
29.         ActiveSheet.[a1].Select
    
30.         Application.CutCopyMode = False
    
31.         wb.SaveCopyAs p1 & fn & ".xls"
    
32.         wb.Close
    
33.     Next
    
34.     Application.ScreenUpdating = True
    
35.     MsgBox "OK！"
    
36. End Sub
    

复制代码

powerremain

ykcbf1100 发表于 2024-3-16 19:34
原格式拆分为多工作簿

感谢老师帮助！我回去学习一下。

ykcbf1100

powerremain 发表于 2024-3-16 19:42
感谢老师帮助！我回去学习一下。

代码比较难懂，你细品一下。

powerremain

ykcbf1100 发表于 2024-3-16 19:53
代码比较难懂，你细品一下。

可以，能看懂。多谢

ykcbf1100

powerremain 发表于 2024-3-16 21:05
可以，能看懂。多谢

那你VBA基础不错。

lizhipei78

ykcbf1100 发表于 2024-3-16 21:14
那你VBA基础不错。

写的我都有点看不懂得，好久不写代码了，参与一下

lizhipei78

参与一下

文件拆分.rar (25 KB, 下载次数: 8)

2024-3-16 23:03 上传

点击文件名下载附件

ykcbf1100

lizhipei78 发表于 2024-3-16 23:03
参与一下

解题思路不借，但是，还有几个小问题。
1、新生成文件中多了一行标题行，2、最后一个文件缺失，3、新生成文件不是原格式。
小改一下，可以达到要求的效果了。