Array mit Find durchsuchen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Tomm,
na ich weiß nicht, ob dein Prozessor die notwendigen Cannabinoiede vorweist. Aber ich denke das kommt eher von hacken / zerpflücken / zerschneiden (Haschee). Das ganz beruht auf der Indexierung der Arrayeinträge und ist auf numerische Werte angewiesen. Aber alle nicht numerischen Werte lassen sich über ihren Asciicode in numerische Werte umwandeln. Die Indexierung erfolgt über den Modulowert des Eintrags mit einer Primzahl.
Ein Beispielprogramm:

Option Explicit
Private Const intIndex As Integer = 1000
Private SrchArr(1 To intIndex) As Integer, HashArr(1 To intIndex * 2) As Integer
Private minPrim As Long, maxPrim As Long
'Über diese Funktion wird der Index für das
'einfache Hashing ermittelt.
Private Function Hashing(ByVal Element As Integer) As Integer
    Hashing = (Element Mod maxPrim) + 1
End Function
'Über diese Funktion wird zur Vermeidung von Kollisiton
'der Index für das zweite Hashing ermittelt (doppeltes Hashing).
Private Function Doppeltes_Hashing(ByVal Element As Integer) As Integer
    Doppeltes_Hashing = (Element Mod minPrim) + 1
End Function
'Die Prozedur Init_Arr dient zum Initialisieren des zu durchsuchenden Arrays,
'der Ermittlung der den einzelnen Werten zugehörigen Hashindizes sowie der
'Belegung des Hash-Arrays mit diesen Indizes.
Private Sub Init_Arr()
    Dim i As Integer, j As Integer, k As Integer
    'Initialisierung des zu durchsuchenden Arrays.
    For i = 1 To intIndex
        SrchArr(i) = i
    Next i
    'Initialisierung des Hash-Arrays.
    Erase HashArr
    'Verteilung der Suchwerte über die Hashindizes
    'im Hash-Array.
    For i = 1 To intIndex
        'Einfaches Hashing.
        j = Hashing(SrchArr(i))
        If HashArr(j) = 0 Then
            HashArr(j) = SrchArr(i)
        Else
            'Doppeltes Hashing zur Vermeidung von Kollision.
            k = Doppeltes_Hashing(SrchArr(i))
            Do
                j = Hashing(j + k)
            Loop Until HashArr(j) = 0
            HashArr(j) = SrchArr(i)
        End If
    Next i
End Sub
'Die Prozedur Hash_Search sucht den übergebenen Wert indem sie
'zunächst den zugehörigen Hashindex ermittelt und über diesen dann
'den Suchwert abfragt.
Private Sub Hash_Search(ByVal SuchElement As Integer, ByRef Gefunden As Boolean)
    Dim i As Integer, j As Integer, k As Integer
    'Ermittlung des einfachen Hashindex für den zusuchenden Wert.
    j = Hashing(SuchElement)
    'Ausfindigmachen des Suchwerts im Hash-Array.
    If HashArr(j) = 0 Then
        Gefunden = False
    Else
        If HashArr(j) = SuchElement Then
            Gefunden = True
        Else
            'Ermittlung des Index für das doppelte Hashing anhand des Suchwerts.
            k = Doppeltes_Hashing(SuchElement)
            Do
                j = Hashing(j + k)
            Loop Until (HashArr(j) = 0) Or (HashArr(j) = SuchElement)
            Gefunden = (HashArr(j) = SuchElement)
        End If
    End If
End Sub
'Die Prozedur Primzahlen liefert die nächstgrößere und
'nächstkleinere Primzahl ausgehen von Arrayindex
Private Sub Primzahlen(ByVal lng_startwert As Long, ByRef lng_kleiner As Long, ByRef lng_groesser As Long)
    Dim lng_counter As Long, lng_startwert_k As Long, lng_startwert_g As Long
    If lng_startwert Mod 10 <> 0 Then
        lng_startwert_k = lng_startwert - (lng_startwert Mod 10)
        lng_startwert_g = lng_startwert + 10 - (lng_startwert Mod 10)
    Else
        lng_startwert_k = lng_startwert
        lng_startwert_g = lng_startwert
    End If
    For lng_counter = lng_startwert_k To 2 Step -10
        If IsPrim(lng_counter - 1) Then lng_kleiner = lng_counter - 1: Exit For
        If IsPrim(lng_counter - 3) Then lng_kleiner = lng_counter - 3:  Exit For
        If IsPrim(lng_counter - 7) Then lng_kleiner = lng_counter - 7:  Exit For
        If IsPrim(lng_counter - 9) Then lng_kleiner = lng_counter - 9:  Exit For
    Next
    For lng_counter = lng_startwert_g To lng_startwert_g * 2 Step 10
        If IsPrim(lng_counter + 1) Then lng_groesser = lng_counter + 1: Exit For
        If IsPrim(lng_counter + 3) Then lng_groesser = lng_counter + 3: Exit For
        If IsPrim(lng_counter + 7) Then lng_groesser = lng_counter + 7: Exit For
        If IsPrim(lng_counter + 9) Then lng_groesser = lng_counter + 9: Exit For
    Next
End Sub
'Diese Funktion prüft Zahlen, ob diese Prim sind oder nicht
Private Function IsPrim(ByVal lng_pruefziffer As Long) As Boolean
    Dim lng_counter As Long
    If lng_pruefziffer Mod 3 = 0 Then Exit Function
    If lng_pruefziffer Mod 7 = 0 Then Exit Function
    For lng_counter = 10 To CLng(lng_pruefziffer ^ 0.5) Step 10
        If lng_pruefziffer Mod (lng_counter + 1) = 0 Then Exit Function
        If lng_pruefziffer Mod (lng_counter + 3) = 0 Then Exit Function
        If lng_pruefziffer Mod (lng_counter + 7) = 0 Then Exit Function
        If lng_pruefziffer Mod (lng_counter + 9) = 0 Then Exit Function
    Next
    IsPrim = True
End Function
'Über diese Prozedur wird das Suchergebnis ausgegeben.
Private Sub SrchAusgabe(ByRef SuchElement As Integer, ByRef Gefunden As Boolean)
    MsgBox SuchElement & IIf(Gefunden, "", " nicht") & " gefunden in Array."
End Sub
'Die Hauptprozedur führt die vorab aufgeführten Prozeduren aus
'indem sie einige Suchen durchführt und diese Prozeduren einsetzt.
Public Sub Hash_Search_Test()
    Dim Gefunden As Boolean
    Call Primzahlen(intIndex, minPrim, maxPrim)
    Call Init_Arr
    Call Hash_Search(1901, Gefunden)
    Call SrchAusgabe(1901, Gefunden)
    Call Hash_Search(11, Gefunden)
    Call SrchAusgabe(11, Gefunden)
    Call Hash_Search(4444, Gefunden)
    Call SrchAusgabe(4444, Gefunden)
    Call Hash_Search(22, Gefunden)
    Call SrchAusgabe(22, Gefunden)
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread