[已解决]如何写一个代码，根据D列日期，判断月份，后自动复制到它对应月份表格，谢谢

fangniuji

如何写一个代码，根据D列日期，判断月份，后自动复制到它对应月份表格，谢谢。

最佳答案

月排行榜 / 总排行榜

爱疯

2012-1-17 17:25

fangniuji 发表于 2012-1-17 14:35
速度满了点，谢谢！！！如果判断月份，后自动生出6月表格并把文件复制到它对应月份表格，这样更好，谢谢！！ ...

1. 
   
2. Sub test()
   
3.     Dim i&, j&, k&, s&, A(), B()
   
4. 
   
5.     With Sheets("整理")
   
6.         i = .Range("d3").End(xlDown).Row
   
7.         A = Range("a3:g" & i).Value
   
8.     End With
   
9.     ReDim B(1 To UBound(A), 1 To UBound(A, 2))
   
10. 
    
11.     For i = 1 To 12
    
12.         '满足条件,就加入数组b
    
13.         s = 0
    
14.         For j = 1 To UBound(A)
    
15.             If Month(A(j, 4)) = i Then
    
16.                 s = s + 1
    
17.                 For k = 1 To UBound(A, 2)
    
18.                     B(s, k) = A(j, k)
    
19.                 Next k
    
20.             End If
    
21.         Next j
    
22. 
    
23.         '导入第i个工作表中
    
24.         With Sheets(i & "月")
    
25.             .Range("a3:g65536").ClearContents
    
26.             If s > 0 Then
    
27.                 .Range("a3").Resize(s, UBound(A, 2)) = B
    
28.             End If
    
29.         End With
    
30.     Next i
    
31. End Sub

复制代码

跳转到最佳答案楼层

fangniuji

如果判断月份，后自动生出6月表格并把文件复制到它对应月份表格，这样更好，谢谢！！！！

0Mouse

1. Sub test()
   
2. Dim x As Integer, i As Integer, mon As String
   
3. For x = 2 To 13
   
4.     Rows(2).Copy Sheets(x).[a1]
   
5. Next
   
6. For i = 3 To Cells(Rows.Count, "D").End(xlUp).Row
   
7.     mon = Month(Cells(i, "D")) & "月"
   
8.     Cells(i, "D").EntireRow.Copy Sheets(mon).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
   
9. Next
   
10. End Sub

复制代码

fangniuji

速度满了点，谢谢！！！如果判断月份，后自动生出6月表格并把文件复制到它对应月份表格，这样更好，谢谢！！！！

爱疯

fangniuji 发表于 2012-1-17 14:35
速度满了点，谢谢！！！如果判断月份，后自动生出6月表格并把文件复制到它对应月份表格，这样更好，谢谢！！ ...

1. 
   
2. Sub test()
   
3.     Dim i&, j&, k&, s&, A(), B()
   
4. 
   
5.     With Sheets("整理")
   
6.         i = .Range("d3").End(xlDown).Row
   
7.         A = Range("a3:g" & i).Value
   
8.     End With
   
9.     ReDim B(1 To UBound(A), 1 To UBound(A, 2))
   
10. 
    
11.     For i = 1 To 12
    
12.         '满足条件,就加入数组b
    
13.         s = 0
    
14.         For j = 1 To UBound(A)
    
15.             If Month(A(j, 4)) = i Then
    
16.                 s = s + 1
    
17.                 For k = 1 To UBound(A, 2)
    
18.                     B(s, k) = A(j, k)
    
19.                 Next k
    
20.             End If
    
21.         Next j
    
22. 
    
23.         '导入第i个工作表中
    
24.         With Sheets(i & "月")
    
25.             .Range("a3:g65536").ClearContents
    
26.             If s > 0 Then
    
27.                 .Range("a3").Resize(s, UBound(A, 2)) = B
    
28.             End If
    
29.         End With
    
30.     Next i
    
31. End Sub

复制代码

fangniuji

谢谢版主，速度很快了，能不能直接生一个6月表格，谢谢，能再帮忙吗，谢谢！！！！

fangniuji

后自动生出6月表格并把文件复制到6月份表格，这样更好，谢谢！！！！

爱疯

fangniuji 发表于 2012-1-17 20:45
后自动生出6月表格并把文件复制到6月份表格，这样更好，谢谢！！！！

后自动生出6月表格并把文件复制到6月份表格

是说在自动复制到各月中以后。另外，工作表6月单独作为1个文件（1个工作簿）保存，是吗？

fangniuji

判断月份以后，自动添加以当月命名文件簿，并把内容复制到里面。

fangniuji

如附件，谢谢！！！