データ形式を検索してコピー＆ペーストする

Question

私は1年間のデータベースを列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