Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Idee für Schleife gesucht

Forumthread: Idee für Schleife gesucht

Idee für Schleife gesucht
steffen
Hallo Ex(cel)perten,
leider kann ich meine Mappe hier nicht hochladen. Ich versuch's mal zu formulieren.
In Tabelle1 in B habe ich zig Namen doppelt und dreifach. in A stehen dazugehörige Werte
Bsp: Tabelle1
A1=nett B1=Müller
A2=groß B2=Meier
A3=klein B3=Müller
mein Ziel ist in Tabelle2 in A1 den Müller und ab B1 nach unten aufgelistet die dazugehörigen Werte aus Tabelle1. Wenn das komplett ist, soll in A? der nächste Name erscheinen (hier also Meier) und in B wieder untereinander aufgelistet die Werte aus Tabelle1, also so hier:
Ergebnis: Tabelle2
A1=Müller B1=nett
A2=leer B2=klein
A3=Meier B3=groß
usw.
ich bekomm einfach diese Schleife mittels VBA nicht hin. Da die Liste immer wieder in der Länge variiert möchte ich das gern automatisiert per Code erledigen lassen.
Gruß Steffen
Anzeige

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

Betreff
Benutzer
Anzeige
AW: Idee für Schleife gesucht
29.06.2009 11:01:34
Rudi
Hallo,
warum nicht einfach eine Pivot-Tabelle?
Gruß
Rudi
AW: Idee für Schleife gesucht
29.06.2009 11:20:59
Tino
Hallo,
habe hier mal was zusammengebastelt, kannst ja mal testen.
Option Explicit

Sub Test()
Dim myDic As Object
Dim myAr, myItems
Dim A As Long, B As Long
Set myDic = CreateObject("Scripting.Dictionary")

With Application
 .ScreenUpdating = False
 .EnableEvents = False

    With Sheets("Tabelle1") 'Tabellename Quelle 
     myAr = .Range("A1", .Cells(.Rows.Count, 2).End(xlUp))
    End With 'Sheets("Tabelle1") 

    For A = 1 To Ubound(myAr)
     myDic(myAr(A, 2)) = 0
    Next A

    
    With Sheets("Tabelle2") 'Tabellename Ziel 
         
         .UsedRange.Value = "" 'leer machen für neue Daten 
         .Rows(1).Font.Bold = True 'Überschrift Fett 
         .Range("A1").Resize(1, myDic.Count) = myDic.Keys 'Überschrift die Namen 
         
         
        For B = 1 To myDic.Count
          For A = 1 To Ubound(myAr)
            If .Cells(1, B) = myAr(A, 2) Then
             .Cells(.Rows.Count, B).End(xlUp).Offset(1, 0) = myAr(A, 1)
            End If
          Next A
        Next B
    
    End With 'Sheets("Tabelle2") 
 
 .ScreenUpdating = True
 .EnableEvents = True
End With 'Application 
End Sub


Gruß Tino

Anzeige
AW: Idee für Schleife gesucht
29.06.2009 11:47:40
steffen
oje, da bin ich aber ganz schön überfordert....
.Range("A1").Resize(1, myDic.Count) = myDic.Keys 'Überschrift die Namen (hier Debugger)
If .Cells(1, B) = myAr(A, 2) Then (hier Debugger)
dort bleibt die Pruzedur jeweils stehen
Gruß Steffen
Lade mal Deine Beispieldatei.
29.06.2009 11:55:57
Tino
Hallo,
lade mal Deine Beispieldatei hoch, sachen die nicht zum Thema gehören kannst Du ja löschen.
Gruß Tino
Anzeige
hochladen nicht möglich :(
29.06.2009 14:37:37
steffen
Hi Tino,
hochladen geht heir nicht- alle geblockt (Firmenrechner)
hab mir da was zusammengebastelt, sicherlich nicht optimal (dauert ziemlich lange - aber funzt)
danke für Deine Anregungen.
Gruß Steffen
;

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