Office: VBA suchen in zweidimensionalem Array ohne Schleife

Hallo!
Ich möchte gern einfacher und schneller in einem zweidimensionalem Array in einer Dimension suchen und als Rückgabewert die Position des Arrays haben um in diesem Fall in der zweiten Dimension den schon vorhandenen Wert aufzusummieren. Derzeit löse ich das simpel über eine Schleife was aber in Kombination mit teilweise mehr zu 300 Feldern viel zu lange dauert.
Hier der Ausschnitt aus dem derzeitigen Konstrukt:

Code:

Private Function fnc_legeArrayAn(ByVal intPosGefunden As Integer)
Dim intDatenArrayzaehler As Integer, bytDatGefunden As Byte

'Zaehler setzen
    intAnzahl_gefunden = intAnzahl_gefunden + 1

    'suche Apgs in Spalte & Summiere APGS Zeile die Spalte +1 zur Ziel Spalte/Zeile Überschrift Array
    For intzaehlerB = LBound(arrUeberschrift_dashier) To UBound(arrUeberschrift_dashier)
    If Not arrUeberschrift_dashier(intzaehlerB) = "***" Or Not InStr(1, Trim(arrUeberschrift_dashier(intzaehlerB)), "***") > 0 Then
    intPosGefunden = fncFundstelle(objQuell_Datei.Worksheets(strKTR_Name).Columns(lngQuellDatSpaltzaehler), arrUeberschrift_dashier(intzaehlerB))
    If Not intPosGefunden = 0 Then
    'wenn apgs gefunden lege Array an und addiere auf
    'Daten zuweisen wenn APGS schon vorhanden ansonsten neu anlegen
    bytDatGefunden = 0
    For intDatenArrayzaehler = 0 To UBound(arrDatenArray)
    If arrDatenArray(intDatenArrayzaehler, 0) = arrUeberschrift_dashier(intzaehlerB) Then
        'summe addieren
        arrDatenArray(intDatenArrayzaehler, 1) = CCur(arrDatenArray(intDatenArrayzaehler, 1)) + objQuell_Datei.Worksheets(strKTR_Name).Cells(intPosGefunden, lngQuellDatSpaltzaehler + 1).Value
        bytDatGefunden = 1
    End If

    Next intDatenArrayzaehler
    'wenn nicht vorhanden dann erstelle wert neu
    If bytDatGefunden = 0 Then
    ReDimEx arrDatenArray, UBound(arrDatenArray) + 1, 1
        arrDatenArray(UBound(arrDatenArray), 0) = arrUeberschrift_dashier(intzaehlerB)
        arrDatenArray(UBound(arrDatenArray), 1) = objQuell_Datei.Worksheets(strKTR_Name).Cells(intPosGefunden, lngQuellDatSpaltzaehler + 1).Value

    End If: End If: End If
    Next intzaehlerB

End Function
Public Function ReDimEx(ByRef arrDatenArray As Variant, ByVal intDimX As Integer, ByVal intDimY As Integer)
  Dim MyTempArray As Variant, I As Integer, J As Integer
  
  MyTempArray = arrDatenArray
  ReDim arrDatenArray(intDimX, intDimY)
  For I = LBound(MyTempArray, 1) To UBound(MyTempArray, 1)
    For J = LBound(MyTempArray, 2) To UBound(MyTempArray, 2)
      If I <= intDimX And J <= intDimY Then
        arrDatenArray(I, J) = MyTempArray(I, J)
      End If
    Next J
  Next I

Ich habe es schon mit der Application.Match versucht, allerdings ist mir hierbei nicht klar, wie man den gesamten Bereich nur der ersten Dimension anspricht

Vielen Dank für die Hilfe!!

andysmith

P.s. mir ist klar das ich die Dimensionserweiterung auch über REDIM PRESERVE hätte lösen können, nachdem ich die Seiten getauscht hätte. Ursprünglich war das Array mehrdimnesional und ich hatte keinen Bock alles zu ändern :-?

 

Hallo!

Die Methode "Application.Match(Such,Bereich,Sort)" ist identisch mit der Methode "Worksheetfunction.Match(Such,Bereich,Sort)", wobei "Bereich" ein Zellbereich (einspaltig bzw. einzeilig) in einem Excel-Arbeitsblatt ist, "Such" der Wert ist, der in diesem Bereich gesucht werden soll, und "Sort" ist die Art, wie die Werte im Bereich sortiert sind. Diese Funktionen sind außerdem identisch zur Arbeitsblattfunktion VERGLEICH(Suchkriterium;Suchmatrix;[Vergleichstyp]). Details kannst Du somit dort nachlesen.
Um bei Deinem VBA-Beispiel zu bleiben, müsste man wahrscheinlich die Funktion "fncFundstelle" so mittels Match-Funktion programmieren:

Code:

Public Function fncFundstelle(Bereich As Range, Such As String) As Long
  On Error Resume Next
  fncFundstelle = Application.Match(Such$, Bereich, 0)
  If Err Then fncFundstelle = 0
End Function

Wenn Du mit dieser Funktionsmethode jedoch ein VBA-Array durchsuchen möchtest, so wirst Du damit leider keinen Erfolg haben, denn der Parameter "Bereich" bzw. "Suchmatrix" erwartet sich ein Excel-Range-Objekt und kein VBA-Array.