【函数初级201203班】练习6---批量分月【已开贴】

yjeeee

第一次写VBA程序，看看中不中，请学委指点！！！

1. Sub FL1()
   
2. Dim i, j, r As Integer
   
3. For i = 9 To 100
   
4. If Sheet1.Cells(1, i) = "" Then
   
5. Exit For
   
6. End If
   
7. r = 2
   
8. For j = 2 To 71
   
9. If (Sheet1.Cells(j, 3) < DateSerial(2012, i - 6, 1)) And Sheet1.Cells(j, 4) = "在职" Then
   
10. Sheet1.Cells(r, i) = Sheet1.Cells(j, 2)
    
11. r = r + 1
    
12. Else
    
13. If Sheet1.Cells(j, 4) <> "在职" And Sheet1.Cells(j, 3) < DateSerial(2012, i - 6, 1) And Sheet1.Cells(j, 4) > DateSerial(2012, i - 6, Day(DateSerial(2012, i - 6, 0))) Then
    
14. Sheet1.Cells(r, i) = Sheet1.Cells(j, 2)
    
15. r = r + 1
    
16. End If
    
17. End If
    
18. Next j
    
19. Next i
    
20. End Sub

复制代码

hwc2ycy

1. Sub 分月()
   
2.     Dim arr, arrresult
   
3.     Dim j As Byte, k As Byte
   
4.     Dim i As Long
   
5.     Dim yr As Integer
   
6.     Dim t#
   
7.     t = Timer
   
8.     yr = Left([f1], 4)
   
9.     arr = Range("a1").CurrentRegion
   
10.     Dim arrC(1 To 12) As Byte
    
11.     ReDim arrresult(1 To UBound(arr), 1 To 12)
    
12.     For i = 2 To UBound(arr)
    
13.         If year(arr(i, 3)) = yr Then
    
14.             j = Month(arr(i, 3))
    
15.             If arr(i, 4) = "在职" Then
    
16.                 k = 12
    
17.             Else
    
18.                 k = Month(arr(i, 3)) - 1
    
19.             End If
    
20.             For j = j To k
    
21.                 arrC(j) = arrC(j) + 1
    
22.                 arrresult(arrC(j), j) = arr(i, 2)
    
23.             Next
    
24.         End If
    
25.     Next
    
26.     Range("g2").Resize(UBound(arrresult), UBound(arrresult, 2)) = arrresult
    
27.     t = Timer - t
    
28.     MsgBox t
    
29. End Sub

复制代码

虎刺梅

下载学习看看。