Sortiertes Array durchsuchen


                            Hi,

Selber Oooooooooooooooops !

Ich wollte nicht, dass Du Dir noch weiter Mühe machst, aber nu' ist zu spät.

Da ich Funktions-Fetischist bin, hier der Vollständigkeit halber die für mich angepasste Funktion.

Grüsse

Werner

Sub KlapptBeiDirNichtEsSeiDennDuHastEineSolcheCombobox()

Dim lngZn&

With dbs.DbBxGE

For lngZn = 0 To .ListCount - 1

If Not lngZn = ComboboxZeileSortSp(dbs.DbBxGE _

, CDate(.List(lngZn, 3)), 3) Then MsgBox "Da haut was nicht hin!" & vbLf & lngZn

Next lngZn

End With

End Sub

'Liefert ZeilenNr einer Combobox mit sortierter DatumsSpalte (Schnell)

Private Function ComboboxZeileSortSp(objDbBx As MSForms.ComboBox _
, datDatum As Date, intSpalte%) As Long
Dim lngAnf&, lngEnde&, lngNeuAnf&, lngAltAnf&
With objDbBx
lngAnf = 0
lngEnde = .ListCount - 1
lngAltAnf = 0
Do
lngNeuAnf = (lngAnf + lngEnde) / 2
If datDatum = CDate(.List(lngEnde, intSpalte)) Then _
ComboboxZeileSortSp = lngEnde: Exit Function
If lngNeuAnf = lngAltAnf Then ComboboxZeileSortSp = -1: Exit Function
If datDatum = CDate(.List(lngNeuAnf, intSpalte)) Then _
ComboboxZeileSortSp = lngNeuAnf: Exit Function
If datDatum < CDate(.List(lngNeuAnf, intSpalte)) Then
lngAnf = lngAnf
lngEnde = lngNeuAnf
lngAltAnf = lngNeuAnf
Else
lngAnf = lngNeuAnf
lngEnde = lngEnde
lngAltAnf = lngNeuAnf
End If
Loop
End With
End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Versatz() Dim Äpfel As Long Dim Birnen As Long Dim arrObst Dim lngVergleich As Long arrObst = Array(Array("Äpfel", "Birnen"), Array(10, 20)) lngVergleich = Application.Match(Range("A1"), arrObst(0), 0) - 1 MsgBox Range("A10").Offset(arrObst(1)(lngVergleich), 0).Address End Sub

Option Explicit Private llngFound As Long Public Sub Test() Dim alngArray(499) As Long, ialngIndex As Long For ialngIndex = LBound(alngArray) To UBound(alngArray) alngArray(ialngIndex) = ialngIndex Next Call Search(alngArray, 222, LBound(alngArray), UBound(alngArray), 0) If llngFound > 0 Then MsgBox llngFound, vbInformation, "Info" Else MsgBox "Nix gefunden.", vbExclamation, "Hinweis" End If End Sub Private Sub Search( _ ByRef pralngArray() As Long, _ ByVal pvlngSearch As Long, _ ByVal pvlngLBound As Long, _ ByVal pvlngUbound As Long, _ ByRef prlngLastIndex As Long) Dim lngNewIndex As Long lngNewIndex = (pvlngLBound + pvlngUbound) \ 2 If lngNewIndex = prlngLastIndex Then llngFound = 0 ElseIf pralngArray(lngNewIndex) = pvlngSearch Then llngFound = lngNewIndex ElseIf pralngArray(lngNewIndex) > pvlngSearch Then Call Search(pralngArray(), pvlngSearch, pvlngLBound, lngNewIndex, lngNewIndex) ElseIf pralngArray(lngNewIndex) < pvlngSearch Then Call Search(pralngArray(), pvlngSearch, lngNewIndex, pvlngUbound, lngNewIndex) End If End Sub Gruß Nepumuk

Option Explicit Private llngFound As Long, llngEnd As Long Public Sub Test() Dim adtmArray(364) As Date, ialngIndex As Long For ialngIndex = LBound(adtmArray) To UBound(adtmArray) adtmArray(ialngIndex) = DateSerial(Year(Date), 1, ialngIndex + 1) Next llngEnd = LBound(adtmArray) - 1 Call Search(adtmArray, DateSerial(2015, 12, 31), LBound(adtmArray) - 1, UBound(adtmArray) + 1, 0) If llngFound = llngEnd Then MsgBox "Nix gefunden.", vbExclamation, "Hinweis" Else MsgBox CStr(adtmArray(llngFound)) & " an Position " & CStr(llngFound), vbInformation, "Info" End If End Sub Private Sub Search( _ ByRef pradtmArray() As Date, _ ByVal pvdtmSearch As Date, _ ByVal pvlngLBound As Long, _ ByVal pvlngUbound As Long, _ ByRef prlngLastIndex As Long) Dim lngNewIndex As Long lngNewIndex = (pvlngLBound + pvlngUbound) \ 2 If lngNewIndex = prlngLastIndex Then llngFound = llngEnd ElseIf pradtmArray(lngNewIndex) = pvdtmSearch Then llngFound = lngNewIndex ElseIf pradtmArray(lngNewIndex) > pvdtmSearch Then Call Search(pradtmArray(), pvdtmSearch, pvlngLBound, lngNewIndex, lngNewIndex) ElseIf pradtmArray(lngNewIndex) < pvdtmSearch Then Call Search(pradtmArray(), pvdtmSearch, lngNewIndex, pvlngUbound, lngNewIndex) End If End Sub Gruß Nepumuk

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread