合并行与连接date
我有一个包含客户和订阅数据的大型Excel表格。 从这张表我想合并logging/行与连接stop_和start_dates，并在新的工作表中显示结果。 数据的简化版本如下所示。
Customer_id subscription_id start_date stop_date 1034 RV4 30-4-2012 30-1-2015 1035 AB7 30-1-2014 30-3-2014 1035 AB6 30-1-2014 30-3-2014 1035 AB7 30-12-2013 30-1-2014 1035 AB7 12-12-2012 30-12-2013 1035 AB7 12-9-2010 14-1-2011 所以，公式必须检查customer_id和subscription_id。 当工作表中的两行或多行匹配，其中一行的stop_date与另一行的start_date重叠时，则在提取和合并之后，必须显示一行，其中第一行的start_date和另一行的stop_date。 如果有多行连接date，这也必须工作。 所有不符合这些标准的行在提取后保持不变。 所以结果会是这样的：
Customer_id subscription_id start_date stop_date 1034 RV4 30-4-2012 30-1-2015 1035 AB6 30-1-2014 30-3-2014 1035 AB7 12-12-2012 30-3-2014 1035 AB7 12-9-2010 14-1-2011
一个dynamic的解决scheme将是理想的，而新的数据将被添加到原始工作表。 虽然我知道这是可能的，当你确定你所寻找的行总是在彼此之下，这是不是在这种情况下，它不会给你一个非常dynamic的解决scheme。
所以在Excel中我需要一些数组函数，但是在search了很多后我找不到合适的解决scheme。 我也有MATLAB可用，但不知道从哪里开始在这样的问题程序。
一个dynamic的解决scheme可能是可能的，但是如果数据集很大，它可能会让事情变得相当糟糕，因为每次更改一个单元格时都需要它。
基本上我能看到的最好的方法是创build您的customer_id和subscription_id的唯一键，然后收集该键下的所有date范围并合并它们。
像这样的东西应该让你开始（需要参考Microsoft脚本运行时）：
Public Sub LinkSubscriptionDates() Dim data As Dictionary, source As Worksheet, target As Worksheet Set source = ActiveSheet Set data = GetSubscriptions(source) Set target = source.Parent.Worksheets.Add 'Copy headers target.Range(target.Cells(1, 1), target.Cells(1, 4)).Value = _ source.Range(source.Cells(1, 1), source.Cells(1, 4)).Value Dim row As Long row = 2 Dim key As Variant, item As Variant For Each key In data.Keys For Each item In data(key) target.Cells(row, 1) = Split(key, "|")(0) target.Cells(row, 2) = Split(key, "|")(1) target.Cells(row, 3) = Split(item, "|")(0) target.Cells(row, 4) = Split(item, "|")(1) row = row + 1 Next item Next key End Sub Private Function GetSubscriptions(source As Worksheet) As Dictionary Dim subscrips As Dictionary Set subscrips = New Dictionary Dim row As Long Dim cust As String, subs As String, starting As String, ending As String 'Gather all the data as pairs of customer|subscription, starting|ending For row = 2 To source.UsedRange.Rows.Count Dim dates() As String cust = source.Cells(row, 1).Value subs = source.Cells(row, 2).Value 'Valid customer/subscription? If cust <> vbNullString And subs <> vbNullString Then starting = source.Cells(row, 3).Value ending = source.Cells(row, 4).Value 'Has an ending and starting date? If starting <> vbNullString And ending <> vbNullString Then Dim key As String key = cust & "|" & subs 'New combo? If Not subscrips.Exists(key) Then subscrips.Add key, New Collection subscrips(key).Add starting & "|" & ending Else subscrips(key).Add starting & "|" & ending Set subscrips(key) = MergeDates(subscrips(key)) End If End If End If Next row Set GetSubscriptions = subscrips End Function Private Function MergeDates(dates As Collection) As Collection Dim candidate As Long, index As Long Dim values() As String, test() As String Dim merge As Boolean For index = 1 To dates.Count values = Split(dates(index), "|") 'Check to see if it can be merged with any other row. For candidate = index + 1 To dates.Count test = Split(dates(candidate), "|") If CDate(test(0)) >= CDate(values(0)) And _ CDate(test(0)) <= CDate(values(1)) Or _ CDate(test(1)) >= CDate(values(0)) And _ CDate(test(1)) <= CDate(values(1)) Then dates.Remove candidate merge = True Exit For End If Next candidate If merge Then Exit For Next index If merge Then 'Pull both rows out of the collection. dates.Remove index values(0) = IIf(CDate(test(0)) < CDate(values(0)), _ CDate(test(0)), CDate(values(0))) values(1) = IIf(CDate(test(1)) > CDate(values(1)), _ CDate(test(1)), CDate(values(1))) 'Put the merged date range back in. dates.Add values(0) & "|" & values(1) 'Recurse. Set MergeDates = MergeDates(dates) End If Set MergeDates = dates End Function
它确实需要充实数据validation，错误捕获等，它目前只是把结果数据放在一个新的工作表。 所有的工作都是在GetSubscriptions函数中完成的，所以你可以从中获取返回的Dictionary，并且做任何你需要做的事情。