Function binSearchLeft ( vecCollection As NotesViewEntryCollection, varBorder As Variant ) As Long
Dim varTemp As Variant
Dim lngLeft As Long
Dim lngRight As Long
Dim lngMiddle As Long
Dim veEntry As NotesViewEntry
Dim varLeftValue As Variant
Dim varMiddleValue As Variant
Dim varRightValue As Variant
Dim dblDiff As Double, dblDiff2 As Double
binSearchLeft = -1
If vecCollection Is Nothing Then
Exit Function
Else
If vecCollection.Count = 0 Then Exit Function
End If
lngLeft = 1
lngRight = vecCollection.Count
Set veEntry = vecCollection.getFirstEntry
varTemp = veEntry.ColumnValues(2)
If Isarray ( varTemp ) Then varTemp = varTemp (0)
varLeftValue = Cdat ( varTemp )
Set veEntry = vecCollection.GetLastEntry
varTemp = veEntry.ColumnValues(2)
If Isarray ( varTemp ) Then varTemp = varTemp (0)
varRightValue =Cdat ( varTemp )
dblDiff = ( varBorder - varLeftValue)
dblDiff2 = ( varRightValue - varLeftValue )
lngMiddle = lngLeft + Clng ( dblDiff * ( lngRight - lngLeft ) / dblDiff2 )
If lngMiddle < lngLeft Then
binSearchLeft = lngLeft
Exit Function
End If
If lngMiddle > lngRight Then
binSearchLeft = lngRight
Exit Function
End If
Set veEntry = vecCollection.GetNthEntry ( lngMiddle )
varTemp = veEntry.ColumnValues(2)
If Isarray ( varTemp ) Then varTemp = varTemp (0)
varMiddleValue = Cdat ( varTemp )
While ( varMiddleValue < varBorder And lngRight > lngLeft )
If ( varBorder < varMiddleValue ) Then
lngRight = lngMiddle - 1
Else
lngLeft = lngMiddle + 1
End If
lngMiddle = lngLeft + ( ( varBorder - varLeftValue) * ( lngRight - lngLeft ) / ( varRightValue - varLeftValue ) )
Set veEntry = vecCollection.GetNthEntry ( lngMiddle )
varTemp = veEntry.ColumnValues(2)
If Isarray ( varTemp ) Then varTemp = varTemp (0)
varMiddleValue = Cdat ( varTemp )
Wend
If varMiddleValue >= varBorder Then
binSearchLeft = lngMiddle + 1
End If
End Function
Function binSearchRight ( vecCollection As NotesViewEntryCollection, varBorder As Variant ) As Long
Dim varTemp As Variant
Dim lngLeft As Long
Dim lngRight As Long
Dim lngMiddle As Long
Dim veEntry As NotesViewEntry
Dim varLeftValue As Variant
Dim varMiddleValue As Variant
Dim varRightValue As Variant
Dim dblDiff As Double, dblDiff2 As Double
binSearchRight = -1
If vecCollection Is Nothing Then
Exit Function
Else
If vecCollection.Count = 0 Then Exit Function
End If
lngLeft = 1
lngRight = vecCollection.Count
Set veEntry = vecCollection.getFirstEntry
varTemp = veEntry.ColumnValues(2)
If Isarray ( varTemp ) Then varTemp = varTemp (0)
varLeftValue = Cdat ( varTemp )
Set veEntry = vecCollection.getLastEntry
varTemp = veEntry.ColumnValues(2)
If Isarray ( varTemp ) Then varTemp = varTemp (0)
varRightValue =Cdat ( varTemp )
dblDiff = ( varBorder - varLeftValue)
dblDiff2 = ( varRightValue - varLeftValue )
lngMiddle = lngLeft + Clng ( dblDiff * ( lngRight - lngLeft ) / dblDiff2 )
If lngMiddle < lngLeft Then
binSearchRight = lngLeft
Exit Function
End If
If lngMiddle > lngRight Then
binSearchRight = lngRight
Exit Function
End If
Set veEntry = vecCollection.GetNthEntry ( lngMiddle )
varTemp = veEntry.ColumnValues(2)
If Isarray ( varTemp ) Then varTemp = varTemp (0)
varMiddleValue = Cdat ( varTemp )
While ( varMiddleValue <> varBorder And lngRight > lngLeft )
If ( varBorder < varMiddleValue ) Then
lngRight = lngMiddle - 1
Else
lngLeft = lngMiddle + 1
End If
lngMiddle = lngLeft + ( ( varBorder - varLeftValue) * ( lngRight - lngLeft ) / ( varRightValue - varLeftValue ) )
Set veEntry = vecCollection.GetNthEntry ( lngMiddle )
varTemp = veEntry.ColumnValues(2)
If Isarray ( varTemp ) Then varTemp = varTemp (0)
varMiddleValue = Cdat ( varTemp )
Wend
If varMiddleValue >= varBorder Then
binSearchRight = lngMiddle -1
End If
End Function
Sub Initialize
Dim session As New NotesSession
Dim dbCurrent As NotesDatabase
Dim viwLookUp As NotesView
Dim vecTemp As NotesViewEntryCollection
Dim veTemp As NotesViewEntry
Dim nvNav As NotesRichTextNavigator
Dim lngLeft As Long
Dim lngRight As Long
Set dbCurrent = session.CurrentDatabase
Set viwLookUp = dbCurrent.GetView ( "LookUpView" )
Call viwLookUp.Refresh
viwLookUp.AutoUpdate = False
Set vecTemp = viwLookUp.GetAllEntriesByKey( Split ( "Standort:KFZ-Typ" , ":" ), True )
lngLeft = binSearchLeft ( vecTemp, Cdat ( "6.6.2011 8:00:00" ) )
lngRight = binSearchRight ( vecTemp, Cdat ( "9.6.2011 20:00:00" ) )
Msgbox "Links = " + Cstr ( lngLeft ) + " und Rechts = " + Cstr ( lngRight )
If lngLeft > 0 Then
Set veTemp = vecTemp.GetNthEntry ( lngLeft )
Print "Left = " + Cstr ( veTemp.ColumnValues(4) )
End If
If lngRight > 0 Then
Set veTemp = vecTemp.GetNthEntry ( lngRight )
Print "Right = " + Cstr ( veTemp.ColumnValues(4) )
End If
End Sub
*1: Formel für die Spalte Datumsbereich
range := "[" + @Text ( StartDateTime ) + " - " + @Text ( EndDateTime ) + "]" ;
values := @TextToTime ( @Explode (@Eval ( range ) ) );
val1 := @TimeMerge ( values[1] ; StartDateTime );
val2 := @If ( @Elements ( values ) > 1 ; @TimeMerge ( values [ @Elements ( values ) ] ; EndDateTime ); @TimeMerge ( values[1] ; EndDateTime ) );
val3 := @If ( @Elements ( values ) > 2 ; @Subset ( @Subset ( values; @Elements ( values ) - 1 ); 2 - @Elements ( values ) ); "" );
@If ( @Elements ( val2) > 0 & @Elements ( val3 ) > 0 ; val1 : val3 : val2 ; @Elements ( val2) > 0 ; val1 : val2 ; val1 )
Daraus folgt dann eine Datumsliste mit folgenden Angaben:
- Startdatum mit Uhrzeit
- Daten zwischen Startdatum und Enddatum als Mehrfach-Datumsliste ohne Datum
- Enddatum mit Uhrzeit
z.B. [1.1.2011 8:00:00] : [2.1.2011] : [3.1.2011] : [4.1.2011] : [5.1.2011] : [6.1.2011] : [7.1.2011] : [8.1.2011] : [9.1.2011] : [10.1.2011 20:00:00]
oder [1.1.2011 8:00:00] : [1.1.2011 19:00:00]
range := "[" + @Text ( StartDateTime ) + " - " + @Text ( EndDateTime ) + "]" ;
values := @TextToTime ( @Explode ( range ) );
values