Array Ergebniss in gleiche Spalte schreiben?

[silentwolf]

Hallo!
Ich versuche mich mit Arrays etwas besser auszukennen und hab auch schon erste Erfolge damit..
Im darunter stehenden Code funktioniert soweit das es mir die Gewünschten Ergebnisse in einem Array auslesen kann.

Code [Auswählen] Erweitern

Sub UeberweisungAusTextMitArray()
    Dim Lastschrift() As String
    Dim lngRow As Long
    Dim i As Integer
   
    i = 0
    lngRow = 2
   
    ReDim Lastschrift(0) 'resize so it holds 1 string
   
    Do Until Cells(lngRow, 4).Value = ""
        If Cells(lngRow, 5).Value Like "ÜBERWEISUNG*" Then
            Lastschrift(i) = UeberweisungAusTextInArray(Cells(lngRow, 5))
            i = i + 1
            ReDim Preserve Lastschrift(i)
        End If
        lngRow = lngRow + 1
    Loop
    ReDim Preserve Lastschrift(i - 1)

   Erase Lastschrift
   
End Sub

Wie müsste ich denn diesen Code ergänzen damit ich dieses Array in die Selbe Spalte wieder einfügen kann?
Also ich würde gerne dieses Array auswerten und danach wieder in die selbe Spalte einfügen die anderen Werte sollen aber nicht überschrieben werden?
Könnt Ihr mir bitte etwas Hilfe leisten?

Danke
Albert

[Beaker s.a.]

Hallo Albert,
Als erstes würde ich die Schleife umschreiben.

Code [Auswählen] Erweitern

    Do Until Cells(lngRow, 4).Value = ""
        i = i + 1
        ReDim Preserve Lastschrift(i)
        If Cells(lngRow, 5).Value Like "ÜBERWEISUNG*" Then
            Lastschrift(i) = UeberweisungAusTextInArray(Cells(lngRow, 5))
        End If
        lngRow = lngRow + 1
    Loop

Dabei entfällt das ReDim nach der Schleife.

Rückwärts müsste so laufen (Luftcode)

Code [Auswählen] Erweitern


For i = 0 To UBound(Lastschrift)
    Cells(i + 2, 5) = Lastschrift(i)
Next i

gruss ekkehard

[Lachtaube]

Einfacher und schneller fährt man, wenn man aus dem Range ein Array erzeugt und dieses durchsucht.

Code [Auswählen] Erweitern

Option Explicit

'Blatt-Klassenmodul

Public Sub CollectData_Click()
   Dim aSrc(), aDest(), i&, j&

   'Bereich um "B2" auswählen
   With Me.Range("B2").CurrentRegion
      'die oberste Zeile (Überschriften) aus dem Bereich entfernen und einem
      'Array zuweisen
      aSrc = .Offset(1).Resize(.Rows.Count - 1)
   End With
   
   'Ziel-Array ausreichend bemessen
   ReDim aDest(UBound(aSrc) - 1)
   'für alle Zeilen im Quell-Array
   For i = 1 To UBound(aSrc)
      'prüfen, ob die erste Spalte mit "ÜBERWEISUNG" beginnt.
      If InStr(1, aSrc(i, 1), "ÜBERWEISUNG", vbBinaryCompare) = 1 Then
         'Ergebnis im Ziel-Array sammeln und Zähler j um 1 erhöhen
         aDest(j) = Format$(aSrc(i, 2), "000.000 €"): j = j + 1
      End If
   Next
   
   'Ziel-Array auf die tatsächlich erforderliche Größe bemessen.
   If j > 0 Then ReDim Preserve aDest(j - 1)
   
   'beispielhaft das Ergebnis in einer MsgBox darstellen.
   MsgBox Join(aDest, vbNewLine), , "Überweisungen"
End Sub

[silentwolf]

Hallo an Euch beiden!

Leider war ich nicht hier deshalb meine späte Rückmeldung!
Vielen Dank ich werde es mir mal genau ansehen!!

Super!

[silentwolf]

Hallo,
nochmal eine Frage zu Arrays.
Folgenden Code habe ich erstellt um ein Multidimensionales Array zu füllen..

Code [Auswählen] Erweitern

Sub QuickFillArray()
    Dim Gutschriften() As Variant
       
    tblListe.Activate
   
    Gutschriften = Range("A2", Range("A1").End(xlDown).End(xlToRight))
   

    Erase Gutschriften
   
End Sub

Dieses Array besteht aus Zwei Spalten und einigen Zeilen...

Wenn ich nun in der Tabelle tblTest eine Spalte auch als Array speichere Eindimensionales Array.. kann ich dann dieses mit dem Gutschriften Array vergleichen und wenn dieser Wert im Gutschriften Array enthalten ist dieses updaten?

Zum Beispiel in tblTest im Array steht Huber GmbH, Adresse 15, Testinghof ...
In meinen Gutschriften Array steht nur Huber GmbH im ersten Datenfeld und im zweiten eine Nummer 4444

Wenn im tblTest Array Huber GmbH, Adresse 15, Testinghof...  Gutschriften Array zusammenstimmt also is Like Huber* kann ich dann in der tblTest Array 1. Huber GmbH, Adresse 15, Testinghof ... mit Huber GmbH updaten und zum zweiten in einer weiteren Spalte die Nummer 4444 eintragen.

HOffe das ist so halbwegs verständlich was ich vorhabe.. Wäre für Tipps sehr dankbar!

Albert