Excel VBA - 如果日期具有匹配的名称和标题,请检查日期是否属于动态范围,然后采取纠正措施

时间:2018-06-04 14:25:28

标签: excel excel-vba excel-formula vba

我试图通过绘制某人留在每个职位(职位)的年数来创建营业额报告。我已经弄清楚如何删除完全重复和重复的开始/结束日期,但我仍然坚持最后的清理步骤。清理彼此重叠的日期的日期范围,并删除重叠日期的行。这样我多次不计算同一天。

以下是我正在使用的一组简化数据: enter image description here

我需要通过匹配名称来定义范围:

John K. =第2-6行

然后只检查具有匹配职位的日期:

销售=第2,5,6行

锶。销售=第3行

Sales Mng。 =第4行

然后对于行数超过1的数组,检查开始日期和结束日期是否在彼此之内并且以太符合:1。创建新行,其中最早的开始日期超过圈数,最新开始日期超过圈数,并删除原始行重叠。 2.使用带有是/否问题的循环来更新具有最大重叠日期范围的现有行,并删除属于该范围的行。

例如,对于John K.我需要删除第5行和第6行,因为它们属于第2行的日期范围,但是第3行和第4行不需要删除,因为它们是不同的作业标题。

对于Dom Q.,由于没有任何日期属于彼此,因此不需要进行任何更改。

对于Henry S.,我需要将D10更新为D11,然后删除第11行。

我将在其上运行的数据集是200,000行,所以不幸的是它太大而无法手动纠正。我看到了一些很好的公式来检查日期范围是否在彼此之内,但是我不确定如何使它们足够动态以仅检查匹配的名称和标题。

提前感谢您对此的看法,如果需要,我很乐意提供更多数据/背景信息。

1 个答案:

答案 0 :(得分:0)

我找到了一个解决方法,需要额外的手动步骤,但仍然比逐行校正数据更快。它还要求我事先将数据与职称分开,并完全依赖于以特定方式进行排序才能正常工作。

首先进行以​​下排序:

- 按A到Z排序作业结束日期

- 按A到Z排序作业开始日期

- A到Z的提供者

然后我在数据集的末尾添加了3个新列:

新列1:结束日期检查 - 为可空白作业结束日期单元格提供可检查的结束日期

=IF(R2="",TODAY(),R2)

新列2:Q< =高于AE - 必须从第3行开始。如果提供者(名称)在上面的行中相同,请检查作业开始日期是否小于或等于作业结束日期排在上面。

=SUMPRODUCT((B3=OFFSET(B3,-1,0))*(Q3<=OFFSET(AE3,-1,0)))

新栏目3:如果AF = 1,AE> =高于AE - 必须从第3行开始。如果新列2等于1,请检查结束日期是否大于或等于其上方的结束日期。

=SUMPRODUCT((AF3=1)*(AE3>=OFFSET(AE3,-1,0)))

隐藏不必要列的最终结果如下所示: Excel Data Sample 2

在准备数据后,我运行以下宏。这将从Cell AF3开始,检查单元格的值是否为1,否则,它会将当前行(C_Row)和上一行(P_Row)的值增加1并再次检查,直到它到达空白单元格。如果AF单元格为1,则它将检查相应的AG单元格是否也为1。如果AG为1,它将复制当前行作业结束日期的值并将其仅作为值粘贴到上一行的作业结束日期并删除当前行,从而在单行中创建最大重叠时间段并删除冲突的行。如果AE不等于1,它将只删除当前行,因为重叠日期完全在其上方的行内。

Sub Aging_Overlapping_Dates()

Dim C_Row As Long: C_Row = 3
Dim P_Row As Long: P_Row = 2

    'Loops until AF = Blank
    Do While Not Cells(C_Row, "AF") = ""
        'Checks if AF is 1
        If Cells(C_Row, "AF") = 1 Then
            'If AF is 1, check if AG is 1
            If Cells(C_Row, "AG") = 1 Then
                'Moves Job End Date to the previous row and deletes current row
                Cells(C_Row, "R").Copy
                Cells(P_Row, "R").PasteSpecial xlPasteValues
                Rows(C_Row).Select
            End If
            'Deletes Current Row if AF or AG is 1
            Rows(C_Row).Select
            Selection.EntireRow.Delete
        Else
        'Increase row count if row was not deleted
        C_Row = C_Row + 1
        P_Row = P_Row + 1
        End If
    Loop

End Sub