Thema Datum  Von Nutzer Rating
Antwort
22.05.2017 10:11:14 Mike1988
NotSolved
22.05.2017 20:20:14 Gast64121
NotSolved
22.05.2017 21:26:42 Mike1988
NotSolved
Blau Array mit variabler Länge - ReDim
22.05.2017 23:33:10 Gast52427
NotSolved
22.05.2017 23:34:05 Gast5940
NotSolved
23.05.2017 17:53:18 Mike1988
Solved

Ansicht des Beitrags:
Von:
Gast52427
Datum:
22.05.2017 23:33:10
Views:
666
Rating: Antwort:
  Ja
Thema:
Array mit variabler Länge - ReDim

Moin nochmal! Hier mal noch ein Code der mit einer andere Variante - dictionary - läuft. Dabei brauchst du dich nicht um das erweitern des Array etc. kümmern, sondern packst die Treffer in ein dictonary. Zum Nachlesen noch etwas Material:

https://excelmacromastery.com/vba-dictionary/

http://www.snb-vba.eu/VBA_Dictionary_en.html

Evtl. mal noch schauen, ob die Zuordnung der Spalten noch passt. In einem Code hattest du die Anzahl der Spalte B genommen aber aus E die Werte (iim Blatt 2). Am Ende wird entweder Error ausgegeben oder das Array mit den Treffern getrennt durch ";" . Die Werte aus Blatt 1 (Spalte A und P) sind auch in Variablen gepackt. Geht dadurch schneller, als wenn du auf das Blatt zugreifst. VG

 

Sub Auswertung()
 
Dim Liste  'Spalte P
Dim Suche  'Nummern
Dim Verweis 'Spalte A
Dim letzte As Long
Dim FortlaufendeNummer  As Long
Dim LetzteZeile As Long
Dim i As Long
Dim treffer As String
Dim Objekt_Nr As Variant
Dim result As String
Dim Ergebniss As Object
Set Ergebniss = CreateObject("Scripting.Dictionary")

Application.ScreenUpdating = False

With Worksheets("Tabelle1")
    letzte = .Cells(.Rows.Count, "P").End(xlUp).Row
    Liste = .Range("P1:P" & letzte)
    Verweis = .Range("A1:A" & letzte)
End With

Application.ScreenUpdating = False
Worksheets("Tabelle2").Select
LetzteZeile = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row  'Spalte E oder B in Blatt 2??

Suche = Worksheets("Tabelle2").Range("E1:E" & LetzteZeile)
For FortlaufendeNummer = 2 To LetzteZeile
    Nr = Suche(FortlaufendeNummer, 1)
   
    For i = 2 To UBound(Liste)
 
        If CStr(Liste(i, 1)) = Nr Then
            Ergebniss.Add i, CStr(Verweis(i, 1))
            Debug.Print Ergebniss.items()(Ergebniss.Count - 1)
        End If
        
    Next
          
    If Ergebniss.Count = 0 Then
 
        Sheets("Tabelle2").Cells(FortlaufendeNummer, 17) = "Error"
        Ergebniss.RemoveAll
    Else
    'ergebnis ausgeben
        Sheets("Tabelle2").Cells(FortlaufendeNummer, 17) = Join(Ergebniss.items, ";")
    End If
    Ergebniss.RemoveAll
Next
 
 
Application.ScreenUpdating = True
Set Ergebniss = Nothing
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
22.05.2017 10:11:14 Mike1988
NotSolved
22.05.2017 20:20:14 Gast64121
NotSolved
22.05.2017 21:26:42 Mike1988
NotSolved
Blau Array mit variabler Länge - ReDim
22.05.2017 23:33:10 Gast52427
NotSolved
22.05.2017 23:34:05 Gast5940
NotSolved
23.05.2017 17:53:18 Mike1988
Solved