Wie zwei Tabellen zusammengeführt werden, wie im folgenden Beitrag erwähnt?

Question

Ich habe zwei Datensätze: 1) Datum ::

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 
..... 

bis 31/03/16 23.59.58 mit jedem Datum Reihe hat eine Differenz von 10 sec.

und

2) Startdatum ::

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 

.....

End Datum ::

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 
..... 

Lage ::

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

So verschmelzen diese beiden Datensätze nach Zeit, so dass im ersten Datensatz für jeden Bereich der Start- und Endzeit im zweiten Datensatz dieser Ort für den gleichen Zeitraum im ersten Datensatz angezeigt wird.

z. für die erste Reihe im 2. Datensatz ist der Standort Schlafzimmer vom 29.02.16 21:58:03 bis 01.03.16 07:07:18 also nach dem Beitritt sollte das Schlafzimmer von der ersten Zeile bis zur Endzeit angezeigt werden zB 01/03/16 07:07:18 im 1. Datensatz.

Answer 1

Sie könnte dies versuchen:

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