Question

我试图在Excel中将两个表与日期范围组合在一起。

我有具有特定季节性定价的属性，并且我有具有其他季节性边距的软件包，我需要将两者的日期括号组合在一起。

我可以找出VBA中的所有保证金/定价资料。它包括在这里，因为否则数据在某些情况下看起来相同，即使它不是。但是，即使开始结合日期，我也没有运气。

这是主表;通过加入两个表/范围创建的任何日期都应包含在这些日期中：

我需要将此类区域数据与特定属性数据合并：

当我结合它们时，它需要看起来像这样：

我可以轻松地将数据转储到SQL中，但我需要公司中任何人可以从Excel电子表格中复制的内容。

我尝试了各种配方方案 - 这样做，然后是另一件事。我尝试过使用电源查询进行交叉连接，然后尝试消除我不想要的日期。这些都不起作用。

我从gitgo知道它想要在VBA中完成，而我尝试的其他一切都是有点拖延的策略。问题是，我似乎甚至无法理解所需的逻辑。我对这个逻辑有不止一个用例。

所有属性日期都需要在主表中存在（在一个范围内）。属性可能包含主要范围内根本不存在的日期。

Answer 1

我确信有更有效的方法，但这里是我如何使用命名表作为数据和输出范围。您应该能够修改它以适应。我认为逻辑有点复杂。在代码下面是我的测试输出的屏幕抓取，它与你的表匹配。

Option Explicit
Sub TableMerge()
    Dim i As Integer
    Dim j As Integer
    Dim insert_row As Integer
    Dim prev_FINISH As Date
    Dim Table_1 As ListObject
    Dim Table_2 As ListObject

    insert_row = 2
    prev_FINISH = CDate("01/01/1900")

    Set Table_1 = ActiveSheet.ListObjects("Table1")
    Set Table_2 = ActiveSheet.ListObjects("Table2")

    For i = 1 To Table_2.ListRows.Count
        For j = 1 To Table_1.ListRows.Count

        ' assumes the headers are in place, using range L:R for Table3
            If (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("REG").Index) = Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("REG").Index)) And (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Finish").Index) > Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Start").Index)) And (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("sTART").Index) < Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Finish").Index)) Then
                If (prev_FINISH = CDate("01/01/1900") And (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Start").Index) <= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Finish").Index))) Or (prev_FINISH >= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Start").Index)) Or (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Finish").Index) >= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Start").Index)) Then

                'If (prev_FINISH = CDate("01/01/1900") And (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Start").Index) <= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Finish").Index)) 'Or (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Finish").Index) >= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Finish").Index))) Then
                ' add new entry
                    ActiveSheet.Range("L" & insert_row).Value = Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("REG").Index)
                    ActiveSheet.Range("M" & insert_row).Value = Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Name").Index)
                    ActiveSheet.Range("N" & insert_row).Value = maxoftwo(maxoftwo(Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Start").Index), Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Start").Index)), prev_FINISH)
                    ActiveSheet.Range("O" & insert_row).Value = minoftwo(Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Finish").Index), Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Finish").Index))
                    ActiveSheet.Range("P" & insert_row).Value = Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("MARG").Index)
                    ActiveSheet.Range("Q" & insert_row).Value = Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("COST").Index)
                    ActiveSheet.Range("R" & insert_row).Formula = "=Q:Q/(1-P:P)"
                    If ActiveSheet.Range("O" & insert_row).Value <> Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Finish").Index) Then
                        prev_FINISH = ActiveSheet.Range("O" & insert_row).Value
                    Else
                        prev_FINISH = CDate("01/01/1900")
                        j = 1
                        insert_row = insert_row + 1
                        GoTo Next_i
                    End If
                    insert_row = insert_row + 1
                End If
            End If
        Next j
        prev_FINISH = CDate("01/01/1900")
    Next_i:
    Next i
End Sub

Function maxoftwo(date1 As Date, date2 As Date) As Date
    maxoftwo = date1
    If date2 > date1 Then maxoftwo = date2
End Function

Function minoftwo(date1 As Date, date2 As Date) As Date
    minoftwo = date1
    If date2 < date1 Then minoftwo = date2
End Function

Answer 2

2017年7月6日的原始答案可能适用于上述数据集，但如果表2中的值的结束日期等于关联的表1记录的开始日期（在这种情况下为一天）将不起作用将在最终表格中省略）。我相信我已经通过在第一个IF语句中添加“ =”来解决该问题。还注意到粘贴值时有两个“ maxoftwo”彼此堆叠，不知道为什么-代码似乎只用1就能正常工作。

很长一段时间以来，我一直在寻求帮助来实现这一目标，而这个主题是我到目前为止找到的唯一答案。如果其他人注意到错误或有更好的方法来增强此效果，请告知。谢谢

    Option Explicit
Sub TableMerge()
    Dim i As Integer
    Dim j As Integer
    Dim insert_row As Integer
    Dim prev_FINISH As Date
    Dim Table_1 As ListObject
    Dim Table_2 As ListObject

    insert_row = 2
    prev_FINISH = CDate("01/01/1900")

    Set Table_1 = ActiveSheet.ListObjects("Table1")
    Set Table_2 = ActiveSheet.ListObjects("Table2")

    For i = 1 To Table_2.ListRows.Count
        For j = 1 To Table_1.ListRows.Count

        ' assumes the headers are in place, using range L:R for Table3
            If (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("REG").Index) = Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("REG").Index)) And (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Finish").Index) >= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Start").Index)) And (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("sTART").Index) <= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Finish").Index)) Then
                If (prev_FINISH = CDate("01/01/1900") And (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Start").Index) <= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Finish").Index))) Or (prev_FINISH >= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Start").Index)) Or (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Finish").Index) >= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Start").Index)) Then

                'If (prev_FINISH = CDate("01/01/1900") And (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Start").Index) <= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Finish").Index)) 'Or (Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Finish").Index) >= Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Finish").Index))) Then
                ' add new entry
                    ActiveSheet.Range("L" & insert_row).Value = Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("REG").Index)
                    ActiveSheet.Range("M" & insert_row).Value = Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Name").Index)
                    ActiveSheet.Range("N" & insert_row).Value = maxoftwo(Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Start").Index), Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Start").Index))
                    ActiveSheet.Range("O" & insert_row).Value = minoftwo(Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("Finish").Index), Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Finish").Index))
                    ActiveSheet.Range("P" & insert_row).Value = Table_1.DataBodyRange.Cells(j, Table_1.ListColumns("MARG").Index)
                    ActiveSheet.Range("Q" & insert_row).Value = Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("COST").Index)
                    ActiveSheet.Range("R" & insert_row).Formula = "=Q:Q/(1-P:P)"
                    If ActiveSheet.Range("O" & insert_row).Value <> Table_2.DataBodyRange.Cells(i, Table_2.ListColumns("Finish").Index) Then
                        prev_FINISH = ActiveSheet.Range("O" & insert_row).Value
                    Else
                        prev_FINISH = CDate("01/01/1900")
                        j = 1
                        insert_row = insert_row + 1
                        GoTo Next_i
                    End If
                    insert_row = insert_row + 1
                End If
            End If
        Next j
        prev_FINISH = CDate("01/01/1900")
    Next_i:
    Next i
End Sub

Function maxoftwo(date1 As Date, date2 As Date) As Date
    maxoftwo = date1
    If date2 > date1 Then maxoftwo = date2
End Function

Function minoftwo(date1 As Date, date2 As Date) As Date
    minoftwo = date1
    If date2 < date1 Then minoftwo = date2
End Function

组合两个重叠的日期范围表

2 个答案: