vba - 将一个日期的月-年匹配到另一个日期的日-月

Question

我正在研究一个宏，它根据日期之间的匹配来分配值。我的宏应该遍历一列日期并将每个日期的月份-年份与其他日期的行相匹配。如果匹配，则需要复制相应列中的值。我遇到的问题是将一个日期的提取月份年份与另一个日期的月份日期进行比较。我希望数据看起来像这样的一个简单版本是这样的:



如您所见，该值被复制到与该值旁边的日期相对应的水平部分。根据期限，它会复制固定的次数。

我遇到的问题是匹配日期。我正在尝试将日期的月份年份与第 1 行中的月份年份进行比较，但我的脚本仅在完全匹配时才起作用，即当 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 使用了错误的时间间隔(the documentation is here)。
"y"是一年中的一天，而不是一年。如果您将间隔替换为 "yyyy"，您的代码看起来应该可以工作。 .

这表明:

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