將一個日期的月份與另一個日期的月份匹配

Question

我正在使用一個宏，該宏根據日期之間的匹配來分配值。 我的宏應該遍歷一列日期，並將每個日期的月-年與其他日期的行匹配。 如果存在匹配項，則需要復制對應列中的值。 我遇到的問題是將一個日期的提取月份與另一個日期的月份進行比較。 我希望數據看起來像一個簡單的版本：

如您所見，該值將被復制到與該值旁邊的日期相對應的水平部分中。 根據術語，它會被復制固定次數。

我遇到的問題是匹配日期。 我正在嘗試將Date的月年與第1行中的month-year進行比較，但是我的腳本僅在完全匹配時才起作用，即，當B列中的日期與第1行中的日期匹配時。 B列中的日期是2011年1月1日，則該日期將被復制到正確的單元格中，否則將根本不會被復制。 這是我正在處理的腳本（請注意，我只為季度條款設置了腳本-當我使之生效時，我會將其他條款添加到If語句中。

Sub End_Collate()

    Dim i As Long, j As Long, k As Long
    Dim ws As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim wb As Workbook
    Dim lastrow As Long, lastcolumn As Long, lastrow_reps As Long
    Dim reps As Variant, reps_list As Variant
    Dim min_date As Date, min_date_format As Date, date_diff As Integer
    Dim cell As Range

    Set wb = ActiveWorkbook
    Set ws2 = wb.Sheets("data")
    Set ws = wb.Sheets("Rep_Commission")

    lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    Set reps_list = ws.Range("A3:A" & (lastrow))
    date_diff = DateDiff("m", min_date, Date)

    'loop through each sheet and add in the correct dates to the correct range
    For Each reps In reps_list
        min_date = Application.WorksheetFunction.Min(ws2.Range("H2:H" &
        Cells(Rows.Count, 1).End(xlUp).Row))
        i = 0
        With wb.Worksheets(reps.Text)
            Do While DateDiff("m", min_date, Date) <> 0
                Worksheets(reps.Text).Range("S1").Offset(0, i).Value = min_date
                min_date = DateAdd("m", 1, min_date)
                i = i + 1
            Loop
        End With
    Next reps

    For Each reps In reps_list
        i = 0
        j = 0
        lastrow_reps = Worksheets(reps.Text).Cells(Rows.Count, 1).End(xlUp).Row
        lastcolumn = Worksheets(reps.Text).Cells(1, Columns.Count).End(xlToLeft).Column
        For i = 2 To lastrow_reps
            'currently this is quarterly - once I get it to work I will add options for daily, monthly etc.
            If Worksheets(reps.Text).Cells(i, 11).Value = "Quarterly" Then
                With Worksheets(reps.Text)
                    For j = 18 To lastcolumn
                        If (DatePart("m", .Cells(i, 8)) & DatePart("y", .Cells(i, 8))) = (DatePart("m", .Cells(1, j)) & DatePart("y", .Cells(1, j))) Then
                            .Cells(i, j) = .Cells(i, 18)
                        Else                     'Do nothing (will add error handling here)
                        End If
                    Next j
                End With
            End If
        Next i
    Next reps

End Sub

Answer 1

您使用錯誤的DatePart間隔（ 文檔在此處 ）。

"y"是一年中的一天 ，而不是年份。 如果將間隔替換為"yyyy"則代碼看起來應該可以正常工作。

這表明：

Public Sub DatePartIntervals()
    Debug.Print DatePart("y", Now)
    Debug.Print DatePart("yyyy", Now)
End Sub