按照表格中日期批量生成一定格式名称的新文件

first2wood

各位大侠，刚刚开始用VBA处理数据，最近遇到一个有循环，又要生成新文件的例子，现在感觉很难，我还只会录制macro，然后稍微修改阶段，实在汗颜。所以想问问大家如何实现这个问题。。。先谢过了！！！
问题是这样的：

1.我需要首先从原数据表格中按照日期筛选出某一日的所有数据（筛选）
2.生成以“Lyyyymmdd”格式的新文件，yyyymmdd为数据对应的日期（生成新文件）
2.把所有数据复制粘贴到新文件中（复制粘贴）
3.重复操作这个，直到所有日期都完成（循环）

数据格式如图，我已经把日期单独分离出来了，D


谢谢大家先！！！

first2wood

朱荣兴 发表于 2016-12-6 15:48
用VBA字典和数组可以完成，但是你必须上传你的excel附件，

谢谢大侠指点，我上传一下，数据太多了，我刚刚分割了一个样本出来！

first2wood

朱荣兴 发表于 2016-12-6 15:48
用VBA字典和数组可以完成，但是你必须上传你的excel附件，

已经上传了。

lsc900707

first2wood 发表于 2016-12-6 16:08
已经上传了。

今天有点怪，附件老是上传不了。

lsc900707

first2wood 发表于 2016-12-6 16:08
已经上传了。

参考代码：
Sub 保留表头拆分数据为若干新工作簿()
     Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%
     c = Application.InputBox("请输入拆分列号", , 4, , , , , 1)
     If c = 0 Then Exit Sub
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     arr = [a1].CurrentRegion
     lc = UBound(arr, 2)
     Set rng = [a1].Resize(, lc)
     Set d = CreateObject("scripting.dictionary")
     For i = 2 To UBound(arr)
         If Not d.Exists(arr(i, c)) Then
             Set d(arr(i, c)) = Cells(i, 1).Resize(1, lc)
         Else
             Set d(arr(i, c)) = Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc))
         End If
     Next
     k = d.Keys
     t = d.Items
     For i = 0 To d.Count - 1
         With Workbooks.Add(xlWBATWorksheet)
             rng.Copy .Sheets(1).[a1]
             t(i).Copy .Sheets(1).[a2]
             .SaveAs Filename:=ThisWorkbook.Path & "\" & "L" & Format(k(i), "yyyymmdd"), FileFormat:=xlExcel12
             .Close
         End With
     Next
     Application.DisplayAlerts = True
     Application.ScreenUpdating = True
     MsgBox "完毕"
End Sub

first2wood

朱荣兴 发表于 2016-12-6 17:08

啊，感谢感谢！果然有一些地方看不懂，我要学习一下！谢谢这位大侠！！如果有问题可以请教您么？

first2wood

lsc900707 发表于 2016-12-6 17:17
参考代码：
Sub 保留表头拆分数据为若干新工作簿()
     Dim arr, d As Object, k, t, i&, lc%, rng As ...

谢谢大侠！您这个也是一种解决方案，太好了。我回去都试一下！有不懂的地方可以请教么？

lsc900707

first2wood 发表于 2016-12-6 19:15
谢谢大侠！您这个也是一种解决方案，太好了。我回去都试一下！有不懂的地方可以请教么？

当然可以，但愿能帮到你。