Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Array ReDim (Preserve?)

Forumthread: Array ReDim (Preserve?)

Array ReDim (Preserve?)
17.01.2021 15:17:43
Jerry
Liebe Community,
Ich habe eine Problem mit Arrays.
Zeile Spalte E
6 Otto
7 Maria
8 Maria
9 Franz
10 Otto
11 Otto
12 Otto
13 Franz
14 Franz
Otto Maria Franz
Ich habe eine Liste mit 3 Namen und will auslesen, in welchen Zeilen der jeweilige Name steht.
Also baue ich 3 Arrays auf, jedes für 1 Namen, hier ist die Dimensionierung 1 To 3,
Im Gegensatz zu dem begrenzten Beispiel oben ist die Liste aber viel länger und ich weiss nicht, wie ich
die Dimensionierung für eine vorher unbestimmte Anzahl von Zeilen mache, in der der jeweilige Name vorkommt.
Hier mein (schlechter Code), der nicht funktioniert:
Public Sub probe()
Dim arr()
ReDim arr(1 To 3, 1 To 1)
Dim mm(3) As Integer
Dim Strg As String
Dim such(3) As String
mm(1) = 0
mm(2) = 0
mm(3) = 0
a = Range("E6").Address
b = Range("E6").End(xlDown).Address
Set blatt = Range(a, b)
For Each k In blatt
suchStrg = LCase(k.Value)
Strg = Replace(suchStrg, " ", "")
For p = 1 To 3
such(1) = LCase("Otto")
such(2) = LCase("Maria")
such(3) = LCase("Franz")
If InStr(Strg, such(p)) > 0 Then
mm(p) = mm(p) + 1
ReDim Preserve arr(p, 1 To mm(p))
arr(p, mm(p)) = k.Row
GoTo raus
End If
Next p
raus:
Next k
'Auslesen der Arrays
For i = 1 To 3
If i = 1 Then sp = "E"
If i = 2 Then sp = "F"
If i = 3 Then sp = "G"
rr = 0
For q = 1 To mm(i)
Range(sp & 18).Offset(rr, 0).Value = arr(i, mm(q))
rr = rr + 1
Next q
Next i
'ENDE Auslesen
l = 0
End Sub

Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Array ReDim (Preserve?)
17.01.2021 16:55:48
GraFri
Hallo
Vielleicht hilft dir das weiter:
Option Explicit
Public Sub Probe()
Dim myArr() As Variant
Dim such(3) As String
Dim iRow As Long
' Suchbegriffe
such(1) = "Otto": such(2) = "Maria": such(3) = "Franz"
' eindimensionales Array beginnend mit E6 bis zum Ende einlesen
With ThisWorkbook.Worksheets("Tabelle1")
myArr = Application.Transpose(.Range(.[E6], .Cells(Rows.Count, "E").End(xlUp)))
End With
' Zeigt das 1. Vorkommen des Suchbegriffs
iRow = Application.Match(such(1), myArr, 0) + 5 ' Da ab 6. Zeile
If Err > 0 Then
MsgBox "Nicht gefunden"
Else
MsgBox "An " & iRow & " .Stelle gefunden"
End If
End Sub
mfg, GraFri
Anzeige
AW: Array ReDim (Preserve?)
17.01.2021 17:57:45
GraFri
Hallo
Nachstehender Code durchsucht das Array 'myArr' und packt die Zeilennummern der Funde in das Array 'woGefunden'. Danach wird eine Liste der Funde ausgegeben.
Option Explicit
Public Sub Probe()
Dim myArr() As Variant
Dim such(3) As String
Dim woGefunden() As Long
Dim n As Long, zähler As Long
' Suchbegriffe
such(1) = "Otto": such(2) = "Maria": such(3) = "Franz"
' eindimensionales Array beginnend mit E6 bis zum Ende einlesen
With ThisWorkbook.Worksheets("Tabelle1")
myArr = Application.Transpose(.Range(.[E6], .Cells(Rows.Count, "E").End(xlUp)))
End With
' neu dimensionieren mit maximalen Fundstellen
ReDim woGefunden(1 To UBound(myArr))
' Suche im Array
zähler = 1
For n = 1 To UBound(myArr)
If myArr(n) = such(1) Then woGefunden(zähler) = n + 5: zähler = zähler + 1
Next n
' Kontrolle, ob was gefunden wurde
If zähler = 1 Then  ' kein Fund
MsgBox such(1) & " nicht gefunden"
Exit Sub
End If
' Array woGefunden verkleinern
ReDim Preserve woGefunden(1 To zähler - 1)
' Zeilennummern der Fundstellen in Spalte ab F6 ausgeben
With ThisWorkbook.Worksheets("Tabelle1").Cells(6, 6)
.Resize(UBound(woGefunden) - LBound(woGefunden) + 1, 1) = Application.Transpose(woGefunden)
End With
End Sub
mfg GraFri
Anzeige
AW: Array ReDim (Preserve?)
18.01.2021 08:43:22
Jerry
Vielen Dank GraFri,
Das sieht hervorragend aus, werde mich g,leich damit beschäftigen.
LG
Jerry
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige