Question

我需要编写一个宏来根据日期范围将我的excel文件拆分成多个文件。

我有一个包含以下数据和许多其他类似数据的Excel文件

Name       date_of_birth
A          10-01-2014
B          10-02-2014
C          10-03-2014
D          10-04-2014
E          10-05-2014
F          10-06-2014
G          10-07-2014
H          10-08-2014
I          10-09-2014
J          10-10-2014
K          10-11-2014
L          10-12-2014

我需要将数据拆分成多个文件，每个文件包含4个月的数据。你能帮帮我吗？最终文件应该是：

first.xls

Name    date_of_birth
A       10-01-2014
B       10-02-2014
C       10-03-2014
D       10-04-2014

second.xls

Name    date_of_birth
E       10-05-2014
F       10-06-2014
G       10-07-2014
H       10-08-2014

third.xls

Name    date_of_birth
I       10-09-2014
J       10-10-2014
K       10-11-2014
L       10-12-2014

Answer 1

Sub newfile（）

'Naming the master workbook
Set m = ThisWorkbook

'Creating a new workbook
Set first = Workbooks.Add
    With first
        .Title = "first"
        .Subject = "firs1t"
        .SaveAs Filename:="first.xls"
    End With

'Naming the created workbook for use in macro
Set f = Workbooks("first")

'Naming a worksheet in master
Set wsm = m.Sheets("master")

'lastrow in master excel
lastrow = wsm.Range("A1").End(xlDown).Row

'finding the month from the date
'Dim month As Integer

Dim WS As Worksheet

Set WS = f.Sheets.Add(After:=Sheets(Worksheets.Count))
WS.Name = "first"

c = 2
For i = 2 To lastrow
m = month(wsm.Cells(i, 2))

    If m >= 1 And m <= 4 Then
    WS.Cells(c, 1) = wsm.Cells(i, 1)
    WS.Cells(c, 2) = wsm.Cells(i, 2)
    c = c + 1
    End If

Next i

f.Close

End Sub

Answer 2

Sub test1（）

＆＃39;命名主工作簿

设置m = ThisWorkbook

＆＃39;创建新工作簿

设置first = Workbooks.Add

With first

    .title = "first"

    .Subject = "first"

    .SaveAs Filename:="first.xls"

End With

＆＃39;命名创建的工作簿以在宏

中使用

设置f =工作簿（＆＃34;第一个＆＃34;）

＆＃39;在主文件中命名工作表

设置wsm = ThisWorkbook

＆＃39; lastrow in master excel

lastrow = wsm.Sheets（＆＃34; Sheet1＆＃34;）。范围（＆＃34; A＆＃34;＆amp; _

      wsm.Sheets("Sheet1").Rows.Count).End(xlUp).Row + 1

＆＃39;查找自该日期起的月份

Dim mo As Integer

Dim WS As Worksheet

设置WS = f.Sheets.Add（After：= Sheets（Worksheets.Count））

WS.Name =＆＃34;首先＆＃34;

c = 2

对于i = 2到拉斯维加斯

m = 1

If m >= 1 And m <= 4 Then

WS.Cells(c, 1) = wsm.Cells(i, 1)

WS.Cells(c, 2) = wsm.Cells(i, 2)

c = c + 1

End If

接下来我

f.Close

End Sub

但仍然是If条件来检查m＆gt; 1和m＆lt; 4是否不起作用

根据日期将master excel拆分为多个文件

2 个答案: