Sortiertes Array durchsuchen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Sortiertes Array durchsuchen
von: Werner
Geschrieben am: 25.04.2015 10:48:58

Hallo
Ich denke, ich habe nun genug geschwitzt bei Recherche und Makrotisieren. Ich bin auf der Suche nach einer effizienten Lösung um so schnell wie möglich ein sortiertes Array, im aktuellen Fall eine Liste einer Combobox zu durchsuchen. Eine Spalte enhält sortierte Datumsangaben (nicht jeder Tag ist drin). Meine Idee ist, die Liste während der Suche ständig durch 2 zu teilen (über grösser Datum/kleiner Datum) um so über wenige Schritte zu wenigsten 2 Zeilen zu gelangen in der das gesuchte Datum zu finden ist. Bin jetzt aber leider soweit, dass ich einen Knoten im Kopf habe. Kann mir da jemand weiterhelfen?
Grüsse
Werner

Bild

Betrifft: AW: Sortiertes Array durchsuchen
von: Hajo_Zi
Geschrieben am: 25.04.2015 11:56:14
Hallo Werner,
aus meinem Archiv.
im Array Suchen

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

Von Beverly Karin


Bild

Betrifft: AW: Sortiertes Array durchsuchen
von: Gerd L
Geschrieben am: 25.04.2015 12:21:37
Hallo Werner!
Das Datum wird in der 2. Spalte der Combobox gesucht.

Dim varZeile As Variant
With WorksheetFunction
varZeile = .Match(CLng(CDate("01.01.2015")), .Index(ComboBox1.List, 0, 2), 0)
End With
Gruß Gerd

Bild

Betrifft: AW: Sortiertes Array durchsuchen
von: Nepumuk
Geschrieben am: 25.04.2015 18:17:31
Hallo,
für dein spezielles Problem hast du schon 2 Lösungen. Grundsätzlich kannst du aber auch rekursiv Suchen. Das kannst du auch z.B. auf eine Auflistungsklasse anwenden in denen die WorksheetFunction nicht angewendet werden kann. Beispiel:

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

Bild

Betrifft: AW: Sortiertes Array durchsuchen
von: Werner
Geschrieben am: 26.04.2015 16:58:52
Jau, Nepumuk, das war's. (fast) Die Routine findet zwar 1. und letzte Zeile nicht, aber das kriege ich auch noch hingetüdelt. Vielen Dank!
Werner

Bild

Betrifft: AW: Sortiertes Array durchsuchen
von: Nepumuk
Geschrieben am: 26.04.2015 17:37:49
Hallo,
Oooooooooooooooops !!!!!
So besser?

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

Bild

Betrifft: AW: Sortiertes Array durchsuchen
von: Werner
Geschrieben am: 27.04.2015 15:01:43
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


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Sortiertes Array durchsuchen"