Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1084to1088
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

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

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
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige