Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1516to1520
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

ID suchen, mehrfache Ergebnisse in Zelle Verketten

ID suchen, mehrfache Ergebnisse in Zelle Verketten
14.10.2016 15:41:59
monkeydvedat
Hi Community,
und zwar habe ich folgende Problemstellung (keine expliziten Hinweise im Web gefunden):
Ich habe ein riesiges Excel-Sheet mit 27t Zeilen. In diesem Scheet stehen User-IDs, jeweils eine ID pro Zelle. In der danebenliegenden Zelle sind die Berechtigungen aufgelistet die der jeweilige User hat. Jedes User hat bzw. kann mehrere Rechte haben. Ist dies der Fall dann wird die User-ID öfter aufgelistet mit den jeweils verschiedenen Berechtigungen in der Zelle nebendran. Logischerweise können auch Berechtigungen auch mehreren Usern zugeteilt werden, wobei das bei meinem Problem keine Rolle spielen dürfte.
Ich möchte nun Folgendes tun:
Es sollen alle User (die in einem sep. Sheet stehen) in dem Berechtigungssheet gesucht werden (dort sind die mehrfach aufgelisteten User und deren Berechtigungen in der Nachbarspalte)und jedes mal wenn ein User gefunden wird, dessen Berechtigungen in einer gemeinsamen Zelle verkettet werden.
Insg. sind es 1405 User - mit Mehrfachaufführung inkl. Rechte sind es 27000 Zeilen.
Das Ergebnis sollen also 1405 aufgelistete User sein und alle Berechtigungen die jeder einzelne hat in der Nachbarspalte Verkettet werden (getrennt durch "," oder ";")
Eine Beispieltabelle kann ich leider nicht liefern, da das sensible Daten sind, aber ich denke die Problemstellung sollte verständlich aufgezeigt sein.
Ich hoffe Ihr könnt mir weiterhelfen.
Danke im Voraus!
PS:
Ich habe es mit Index + Vergleich + Verkettung versucht. Eine funkt. Lösungsformel habe ich leider nicht hinbekommen :/

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ID suchen, mehrfache Ergebnisse in Zelle Verketten
14.10.2016 16:02:55
Daniel
Hi
um bei dieser Datenmenge perfomant arbeiten zu können, muss man ein paar Vorbereitungen treffen:
1. Sortiere die Liste nach Usern aufsteigend
2. schreibe in Spalte C folgende Formel, die Formel ist für C2 (erste Zeile ist Überschrift)
=Wenn(A1=A2;C1&",";"")&B2
3. Kopiere die Formel bis ans Tabellenende. Bei jedem letzten eintrag eines Users sollten jetzt alle seine Rechte in einer Zelle stehen.
4. Kopiere die Spalten mit den Usernamen in die Spalte E
5. führe mit der Spalte E die Funktion Daten - DatenTools - Duplikate Entfernen aus, um jeden User nur 1x zu erhalten.
6. Schreibe in die Zelle F2 die Formel =SVerweis(E2;A:C;3;Wahr) und ziehe diese bis zum letzen User
Gruß Daniel
Anzeige
AW: ID suchen, mehrfache Ergebnisse in Zelle Verketten
14.10.2016 16:19:00
UweD
Hallo
so?
Sub ID_123()
    Dim TB1, LR2 As Long, i As Long, C, firstAddress
    Set TB1 = Sheets("Tabelle1")
    With Sheets("Tabelle2")
        LR2 = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte 
        .Columns(2).ClearContents
        .Cells(1, 2) = TB1.Cells(1, 2)
        For i = 2 To LR2
            Set C = TB1.Columns(1).Find(.Cells(i, 1), LookIn:=xlValues)
            If Not C Is Nothing Then
                firstAddress = C.Address
                Do
                    .Cells(i, 2) = .Cells(i, 2) + C.Offset(0, 1) & ";"
                    Set C = TB1.Columns(1).FindNext(C)
                Loop While Not C Is Nothing And C.Address <> firstAddress
            End If
            If .Cells(i, 2) <> "" Then
                .Cells(i, 2) = Left(.Cells(i, 2), Len(.Cells(i, 2)) - 1) 'letzes ; weg 
            End If
       Next
    End With
End Sub

Tabelle1
 AB
1IDBerechtigung
2123A
3568A
4122A
5122B
6568C
7999X


Tabelle2
 AB
1IDBerechtigung
2123A
3568A;C
4122A;B
5999X
6888 
http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip
http://Hajo-Excel.de/tools.htm
XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
Add-In-Version 21.10 einschl. 64 Bit


LG UweD
Anzeige
AW: ID suchen, mehrfache Ergebnisse in Zelle Verketten
14.10.2016 16:40:29
Daniel
Hi
wenn schon Makro, dann auch so dass man die benannte Datenmenge einigermaßen zügig bearbeiten kann:
Sub IDs_Erstellen()
Dim arr
Dim z As Long
Dim dic As Object
Set dic = CreateObject("Scripting.dictionary")
arr = Sheets("Tabelle1").Cells(1, 1).CurrentRegion
For z = 1 To UBound(arr, 1)
dic(CStr(arr(z, 1))) = dic(CStr(arr(z, 1))) & arr(z, 2) & ";"
Next
With Cells(1, 5).Resize(dic.Count, 2)
.Columns(1) = WorksheetFunction.Transpose(dic.keys)
.Columns(2) = WorksheetFunction.Transpose(dic.items)
End With
End Sub
Gruß Daniel
AW: noch ne Makrovariante
14.10.2016 18:07:43
Daniel
Hi
man kann auch das hier verwenden, das ist näher an einer Lösung, wie man sie von Hand in Excel durchführen würde.
Genutzt wird wieder die Sortierung, das zusammenfassen der Werte per Formel und das Duplikate-Entfernen um nicht benötigte Zeilen aus dem Ergebnis zu eleminieren:
Sub test()
Range("A:B").Copy Range("D:E")
With Range("D1").CurrentRegion
.Sort key1:=.Cells(1, 1), order1:=xlAscending, _
key2:=.Cells(1, 2), order1:=xlAscending, Header:=xlYes
.RemoveDuplicates Array(1, 2), xlYes
End With
With Range("D1").CurrentRegion
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = "=RC[-1]&IF(RC[-2]=R[1]C[-2],"",""&R[1]C,"""")"
.Formula = .Value
.Cells(1, 1).Value = "Rechte"
End With
End With
With Range("D1").CurrentRegion
.RemoveDuplicates 1, xlNo
.Columns(2).Delete
End With
End Sub
auch das ist gut für grössere Datenmengen geeignet.
Gruß Daniel
Anzeige
AW: noch ne Makrovariante
17.10.2016 15:28:53
monkeydvedat
@ Daniel: Deine Lösung wie du sie oben beschrieben hast funktioniert einwandfrei. Danke dafür. Auf Makros möchte ich hierbei verzichten. Allerdings brauche ich diese an einer anderen Stelle, denn nun wo ich das Problem gelöst habe, stehe ich vor einem neuen Problem.
Die User sind nun erfolgreich gegliedert inkl. aller Rechte in einer Zelle. Jeder dieser User ist in einer Organisationseinheit (z.B. Finanzbuchhaltung oder Rechtsabteilung). Auch hier können wieder mehrere User in einer OE sein. Nach Filterung habe ich nun 180 verschiedene OE's. Im nächsten Schritt soll für JEDE dieser OE's eine seperate Excel-Datei erstellt werden, wobei die Datei nach der OE benannt werden soll (aufgelistet in sep. Sheet "Tabelle2" siehe Funktion unten) und dann die benötigten Zeilen (also mit Usern, Rechten etc.) dort übernommen werden. Ich sehe keinen Sinn darin das alles Manuell zu machen, denn mal abgesehen davon, dass das sehr Fehleranfällig wäre, dauert mir das auch zulange.
Ich habs mit folg. Schleife versucht um die Dateien zu erstellen:
Sub DateienErstellenSchleife()
Dim i As Integer
Dim Pfad As String
Dim wkb As Workbook
Set wkb = Workbooks.Add
Pfad = "C:\Users\monkeydvedat\Desktop\SAP"
For i = 1 To 10
wkb.Add
With ActiveWorkbook
wkb.SaveAs Environ("UserProfile") & Pfad & Tabelle2.Cells(1, 1).Value & "xlsx"
wkb.Close False
End With
Next
End Sub
Hier bekomme ich den Laufzeitfehler 438 (Objekt unterstützt diese Eigenschaft oder MEthode nicht)
Einen Ansatz, dass die gewünschten Zeilen (User, Rechte, etc..) automatisch in das Sheet übernommen werden habe ich leider nicht.
Danke im voraus für die Hilfe!
LG,
Vedat
Anzeige
AW: noch ne Makrovariante
17.10.2016 15:38:11
monkeydvedat
@ Daniel: Deine Lösung wie du sie oben beschrieben hast funktioniert einwandfrei. Danke dafür. Auf Makros möchte ich hierbei verzichten. Allerdings brauche ich diese an einer anderen Stelle, denn nun wo ich das Problem gelöst habe, stehe ich vor einem neuen Problem.
Die User sind nun erfolgreich gegliedert inkl. aller Rechte in einer Zelle. Jeder dieser User ist in einer Organisationseinheit (z.B. Finanzbuchhaltung oder Rechtsabteilung). Auch hier können wieder mehrere User in einer OE sein. Nach Filterung habe ich nun 180 verschiedene OE's. Im nächsten Schritt soll für JEDE dieser OE's eine seperate Excel-Datei erstellt werden, wobei die Datei nach der OE benannt werden soll (aufgelistet in sep. Sheet "Tabelle2" siehe Funktion unten) und dann die benötigten Zeilen (also mit Usern, Rechten etc.) dort übernommen werden. Ich sehe keinen Sinn darin das alles Manuell zu machen, denn mal abgesehen davon, dass das sehr Fehleranfällig wäre, dauert mir das auch zulange.
Ich habs mit folg. Schleife versucht um die Dateien zu erstellen:
Sub DateienErstellenSchleife()
Dim i As Integer
Dim Pfad As String
Dim wkb As Workbook
Set wkb = Workbooks.Add
Pfad = "C:\Users\monkeydvedat\Desktop\SAP"
For i = 1 To 10
wkb.Add
With ActiveWorkbook
wkb.SaveAs Environ("UserProfile") & Pfad & Tabelle2.Cells(1, 1).Value & "xlsx"
wkb.Close False
End With
Next
End Sub
Hier bekomme ich den Laufzeitfehler 438 (Objekt unterstützt diese Eigenschaft oder MEthode nicht)
Einen Ansatz, dass die gewünschten Zeilen (User, Rechte, etc..) automatisch in das Sheet übernommen werden habe ich leider nicht.
Danke im voraus für die Hilfe!
LG,
Vedat
Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige