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（the documentation is here）使用了错误的时间间隔。

"y"是年份的日期，而不是年份。如果您用"yyyy"替换间隔，则代码看起来应该可以工作。

这表明：

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

将一个日期的月份与另一个日期的月份匹配

1 个答案: