搜索數據格式並複製並粘貼

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