Sub TEST1()
Application.ScreenUpdating = False
Dim X, Y, M, L, ARR, ARR1(1 To 30000, 1 To 23)
Dim WB As Workbook
Set WB = Workbooks.Open(ThisWorkbook.Path & "\数据表.xls", Password:="123456789")
Y = WB.Sheets(1).Range("D" & Rows.Count).End(xlUp).Row
ARR = WB.Sheets(1).Range("A3:W" & Y)
For X = 1 To UBound(ARR, 1)
If (ARR(X, 16) = "" And 3 <= Now - ARR(X, 14)) And ARR(X, 23) = "" And ARR(X, 4) <> "" Then
M = M + 1
For Y = 1 To UBound(ARR, 2)
ARR1(M, Y) = ARR(X, Y)
Next Y
End If
Next X
ThisWorkbook.Sheets(1).Range("A2:W" & Y).Clear
ThisWorkbook.Sheets(1).Range("A2").Resize(UBound(ARR1), 23) = ARR1
WB.Save: WB.Close True
ThisWorkbook.Sheets(1).Range("A2:W" & M + 1).Borders.LineStyle = xlContinuous
Set WB = Nothing
Application.ScreenUpdating = True
End Sub
Sub TEST2()
Application.ScreenUpdating = False
Dim X, Y, M, L, ARR, ARR1(1 To 30000, 1 To 23)
Dim WB As Workbook
Set WB = Workbooks.Open(ThisWorkbook.Path & "\数据表.xls", Password:="123456789")
Y = WB.Sheets(1).Range("D" & Rows.Count).End(xlUp).Row
ARR = WB.Sheets(1).Range("A3:W" & Y)
For X = 1 To UBound(ARR, 1)
If (ARR(X, 15) = "" And 3 <= Now - ARR(X, 14)) And ARR(X, 23) = "" And ARR(X, 4) <> "" Then
M = M + 1
For Y = 1 To UBound(ARR, 2)
ARR1(M, Y) = ARR(X, Y)
Next Y
End If
Next X
ThisWorkbook.Sheets(2).Range("A2:W" & Y).Clear
ThisWorkbook.Sheets(2).Range("A2").Resize(UBound(ARR1), 14) = ARR1
WB.Save: WB.Close True
ThisWorkbook.Sheets(2).Range("A2:N" & M + 1).Borders.LineStyle = xlContinuous
Set WB = Nothing
Application.ScreenUpdating = True
End Sub比如这个代码怎么简化 |