每月复制
- 我已将变量更改
rapid1为字符串。您可能想要更改它以使代码正常工作。
- 尽管实现常量（仅更改一次并在“一个地方”（开始时）快速更改）并适当地命名它们可能会增加其他人的可读性（一段时间后对您来说），但在开发时可能并非如此。因此，我在Main Version下方包含了No Constants Version 。
主要版本
Sub Search_Month()
' Data
Const cSearch As String = "M4" ' Search Value Cell Range
Const cFRD As Long = 7 ' First Row Number
Const cOffset As String = 3 ' Copy Row Offset
Const cCol As Variant = "F" ' Search Column Letter/Number
Const cCopy As Variant = "B" ' Copy Column Letter/Number
' Report
Const cFRR As Long = 2 ' First Row Number
Const cWrite As Variant = "A" ' Write Column Letter/Number
' Data
Dim datasheet As Worksheet ' Worksheet
Dim rng As Range ' Last Cell Range
Dim Search As Long ' Search Month
Dim vntMonth As Variant ' Current Month
Dim i As Long ' Row Counter
' Report
Dim Mreport As Worksheet ' Worksheet
Dim FER As Long ' First Empty Row
' Create References to Worksheets
Set datasheet = Sheet2
Set Mreport = Sheet9
' Speed up
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
On Error GoTo ProcedureExit
' In Data Worksheet
With datasheet
' Assign value from Search Value Cell Range to Search Month.
Search = .Range(cSearch).Value
' In Search Column
With .Columns(cCol)
' Calculate Last Cell Range in Search Column.
Set rng = .Find("*", , xlFormulas, xlWhole, xlByColumns, xlPrevious)
End With
If rng Is Nothing Then ' No data in column (Highly unlikely).
MsgBox "No Data in column '" _
& Split(.Cells(1, cCol).Address, "$")(1) & "'."
GoTo ProcedureExit
End If
' In Report Worksheet
With Mreport
.Unprotect Password:="rapid1"
' Clear contents from First Row to bottom cell of Write Column.
.Cells(cFRR, cWrite).Resize(.Rows.Count - cFRR + 1).ClearContents
' Write First Row Number to First Empty Row.
FER = cFRR
End With
' Loop through cells of Data Worksheet.
For i = cFRD To rng.Row
' Write value of current cell to Current Month.
vntMonth = .Cells(i, cCol)
' Check if Current Month is a date or can be converted to a date.
If IsDate(vntMonth) Then
' Check if month of current cell value is equal to Current Month.
If Month(vntMonth) = Search Then
' Write data from Data Worksheet to Report Worksheet.
Mreport.Cells(FER, cWrite).Resize(cOffset) = _
.Cells(i, cCopy).Resize(cOffset).Value
FER = FER + cOffset
End If
End If
Next
End With
' In Report Worksheet
With Mreport
.Protect Password:="rapid1"
MsgBox "End of Month Report Updated"
End With
ProcedureExit:
' Speed down
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
无常量版本
Sub Search_Month_No_Constants()
' Data
Dim datasheet As Worksheet ' Worksheet
Dim rng As Range ' Last Cell Range
Dim Search As Long ' Search Month
Dim vntMonth As Variant ' Current Month
Dim i As Long ' Row Counter
' Report
Dim Mreport As Worksheet ' Worksheet
Dim FER As Long ' First Empty Row
' Create References to Worksheets
Set datasheet = Sheet2
Set Mreport = Sheet9
' Speed up
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
On Error GoTo ProcedureExit
' In Data Worksheet
With datasheet
' Assign value from Search Value Cell Range to Search Month.
Search = .Range("M4").Value
' In Search Column
With .Columns("F")
' Calculate Last Cell Range in Search Column.
Set rng = .Find("*", , xlFormulas, xlWhole, xlByColumns, xlPrevious)
End With
If rng Is Nothing Then ' No data in column (Highly unlikely).
MsgBox "No Data in column 'F'." _
GoTo ProcedureExit
End If
' In Report Worksheet
With Mreport
.Unprotect Password:="rapid1"
' Clear contents from First Row to bottom cell of Write Column.
.Cells(2, "A").Resize(.Rows.Count - 2 + 1).ClearContents
' Write First Row Number to First Empty Row.
FER = 2
End With
' Loop through cells of Data Worksheet.
For i = 7 To rng.Row
' Write value of current cell to Current Month.
vntMonth = .Cells(i, "F")
' Check if Current Month is a date or can be converted to a date.
If IsDate(vntMonth) Then
' Check if month of current cell value is equal to Current Month.
If Month(vntMonth) = Search Then
' Write data from Data Worksheet to Report Worksheet.
Mreport.Cells(FER, "A").Resize(3) = _
.Cells(i, "B").Resize(3).Value
FER = FER + 3
End If
End If
Next
End With
' In Report Worksheet
With Mreport
.Protect Password:="rapid1"
MsgBox "End of Month Report Updated"
End With
ProcedureExit:
' Speed down
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub