Question

我有两个数据集： 1）日期::

01/03/16 00:00:01
01/03/16 00:00:11
01/03/16 00:00:21
01/03/16 00:00:31
01/03/16 00:00:41
01/03/16 00:00:51
01/03/16 00:01:01
01/03/16 00:01:11
01/03/16 00:01:21 
.....

直到2016年3月31日23:59:58，每个日期行的差异为10秒。

和

2）开始日期::

29/02/16 21:58:03
01/03/16 07:07:18
01/03/16 07:07:37
01/03/16 07:07:38
01/03/16 07:07:47
01/03/16 07:10:06
01/03/16 07:10:36
01/03/16 08:46:09

.....

结束日期::

01/03/16 07:07:18
01/03/16 07:07:37
01/03/16 07:07:37
01/03/16 07:07:38
01/03/16 07:09:56
01/03/16 07:10:06
01/03/16 08:46:09
01/03/16 08:46:29
.....

位置::

Bedroom
Living Room
Bathroom
Kitchen
Bathroom
Kitchen
Bedroom
Living Room
Kitchen
Bathroom
.....

如何按时间合并这两个数据集，以便在第一个数据集中，对于第二个数据集中的每个开始和结束时间范围，它将在第一个数据集中显示相同时间范围的位置。

E.g。对于第2个数据集中的第一行，位置是卧室从29/02/16 21:58:03到01/03/16 07:07:18所以加入之后它应该显示从第一行到结束时间的卧室，即01 / 03/16 07:07:18在第1个数据集中。

Answer 1

你可以试试这个：

Option Explicit

Sub main()
    Dim startDateRng As Range, endDateRng As Range, dateRng As Range, locationRng As Range
    Dim iniCell As Long, endCell As Long, iCell As Long

    SetRanges startDateRng, endDateRng, dateRng, locationRng

    For iCell = 1 To startDateRng.Count '<--| iterate through startDateRng values (and corresponding endDateRng ones)
        iniCell = FindDateIndex(startDateRng(iCell), dateRng, 1)   '<--| get the first valid date in DateRng
        endCell = FindDateIndex(endDateRng(iCell), dateRng, -1) '<--| get the last valid date in DateRng
        If endCell - iniCell + 1 > 0 Then dateRng(iniCell).Resize(endCell - iniCell + 1).Offset(, 1).value = locationRng(iCell) '<--| if a valid range has been found then write values
    Next iCell
End Sub


Function FindDateIndex(rngToSearchFor As Range, rngToSearchIn As Range, indexShift As Long) As Long
    Dim index As Variant

    index = Application.Match(rngToSearchFor.Value2, rngToSearchIn, 1)
    If IsError(index) Then
        FindDateIndex = 1
    Else
        FindDateIndex = index
        If indexShift = 1 Then
            If rngToSearchIn(index) < rngToSearchFor Then FindDateIndex = FindDateIndex + indexShift
        Else
            If rngToSearchIn(index) > rngToSearchFor Then FindDateIndex = FindDateIndex + indexShift
        End If
    End If
End Function


Sub SetRanges(startDateRng As Range, endDateRng As Range, dateRng As Range, locationRng As Range)
    Set startDateRng = SetRange(Worksheets("Start Date"))
    Set endDateRng = SetRange(Worksheets("End Date"))
    Set dateRng = SetRange(Worksheets("Date"))
    Set locationRng = SetRange(Worksheets("Location"))
End Sub

Function SetRange(ws As Worksheet) As Range
    With ws
        Set SetRange = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
    End With
End Function

如何合并两个表，如下文所述？

1 个答案: