Question

我有一年的数据库，在A栏（日期），B栏和相应的数据。 A列的格式为yyyy/mm/dd。目前我使用以下代码，可以指定要复制的范围。现在我想改进它以用于搜索，并复制当前月份数据（A列和B列）。任何帮助都非常感谢。谢谢。

Sub CopyRange()
    Dim FromRange As Range
    Dim ToRange As Range
    Dim Str As String
    Set FromRange = Application.InputBox("Enter The Range Want to Copy", "Update   ", "data!", Type:=8)
    Set ToRange = Application.InputBox("Enter The Range Want to Copy", "Update", "Chart!", Type:=8)

    FromRange.Copy ToRange
End Sub

Sub FindMonth()
Dim LastRow, matchFoundIndex, iCntr As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For iCntr = 1 To LastRow             ' 1 set the start of the dup looks
If Cells(iCntr, 1) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" &   LastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 10) = "same"
End If
End If
Next
End Sub                                                                                                                           This code helps to select  same date, need to modify to select same month.

Answer 1

下面的函数应该能够获取一个字符串参数（例如"2016/12"或Format(Now(), "yyyy/mm")并返回范围（在ActiveSheet内 - 更改以满足您的需要）从该月的第一行，并在该月的最后一行结束。

Function FindMonth(mth As String) As Range
    Dim rngStart As Range
    Dim rngEnd As Range
    With ActiveSheet 'assume ActiveSheet for the moment
        'Find first occurrence
        Set rngStart = .Columns("A").Find(What:=mth, _
                                          After:=.Cells(.Rows.Count, 1), _
                                          LookIn:=xlValues, _
                                          LookAt:=xlPart, _
                                          SearchDirection:=xlNext)
        If rngStart Is Nothing Then
            Set FindMonth = Nothing
        Else
            'Find the last occurrence
            Set rngEnd = .Columns("A").Find(What:=mth, _
                                            After:=rngStart, _
                                            LookIn:=xlValues, _
                                            LookAt:=xlPart, _
                                            SearchDirection:=xlPrevious)
            'Return columns A:B for the rows selected
            Set FindMonth = .Range(.Cells(rngStart.Row, "A"), .Cells(rngEnd.Row, "B"))
        End If
    End With
End Function

假设一个月的所有数据都在一个连续的部分。

可以按如下方式调用该函数

Sub CopyRange()
    Dim FromRange As Range
    Dim ToRange As Range
    Dim Str As String
    Set FromRange = FindMonth("2016/12")
    If FromRange Is Nothing Then
        MsgBox "No data found!"
        Exit Sub
    End If
    Set ToRange = Application.InputBox("Enter The Range Want to Copy", "Update", "Chart!", Type:=8)

    FromRange.Copy ToRange.Cells(1, 1).Address 'Changed to just specify top-left corner of destination
End Sub

搜索数据格式并复制并粘贴

1 个答案: