Office 2010: Erweiterte Sortierung und Struktur mittels VBA

[cekay]

Hey Community!
Ich hoffe ihr könnt mir mal wieder bei einer Problematik weiterhelfen.

Ich erhalte aus einem Export eine Tabelle die eine schwer ersichtliche Struktur verfolgt.
Diese möchte ich gerne mittels VBA hinzufügen.

Die Tabelle orientiert sich in der Struktur einem festem Schema.
Jede Gruppe bildet sich aus der ersten Spalte, der Nummierung, heraus. Diese Gruppe enthält immer den Typ "Basic" sowie "Erweitert". Basic bildet dabei die Basis. Davo gibt es immer nur einen. Erweitertet gibt es jedoch mindestens einmal. In dieser Beziehung sollen nun Duplikate gelöscht werden
Um dies besser zu verstehen habe ich euch folgende Bilder erstellt:




Ist das verständlich genug?



Beste Grüße

[gmg-cc]

Moin,
das geht mit einer Pivot-Tabelle:

[lupo1]

I2: =WENN((SPALTE(A2)<6)*(SPALTE(A2)<>4)*(A1=A2);"";A2) nach rechts und unten

Bei Pivot hakt es an Spalte D. Könnte man natürlich umstellen ...

[cekay]

Hey!

Vielen Dank euch beiden.
Die zweite Variante arbeit sehr gut.
Kann mir die irgendwer kommentieren?
Versuche die nun auf die reele Tabelle mit mehr Spalten und Zellen zu transferieren, komme jedoch nicht ganz so weiter.

[cekay]

Hey!

Ich versuche die Problematik nun mittels VBA zu lösen, komme jedoch nicht weiter.
Ich habe nun folgenden Befehl gefunden, der mir Duplikate entfernt.

Sub clustern()
   
    With tbl_data
   
        .Range("$A:$B").RemoveDuplicates Columns:=1, Header:=xlYes
    End With

End Sub

Das Makro löscht zwar die Duplikate in der ersten Zeile, behält jedoch nicht die Struktur bei. Die originäre Einträge werden nach oben verschoben.
Ebenfalls weiß ich nun nicht, wie ich die Beziehung zu den anderen Spalten herstellen soll.

Hat wer eine Idee bzw. Vorschläge?


Beste Grüße

[maninweb]

Hallo,

anbei ein einfacher Algorithmus, um dies per Code zu machen. Kann dann entsprehend angepasst und optimiert werden.

Code: Visual Basic

1. Sub DuplikateEntfernen()
2.  
3.   Dim n As Long
4.  
5.   Dim u As String
6.   Dim v As String
7.   Dim w As String
8.  
9.   With ThisWorkbook.Worksheets(1)
10.  
11. '   Erste Zeile...
12.    
13.     u = .Cells(2, 2).Value
14.     v = .Cells(2, 3).Value
15.     w = .Cells(2, 5).Value
16.    
17. '   Weitere Zeilen...
18.    
19.     For n = 3 To 25 ' Letzte Zeile
20.      
21.       If u <> .Cells(n, 2).Value Then
22.        
23.         u = .Cells(n, 2).Value
24.        
25.       Else
26.        
27.        .Cells(n, 2).Value = ""
28.        
29.       End If
30.      
31.       If v <> .Cells(n, 3).Value Then
32.        
33.         v = .Cells(n, 3).Value
34.        
35.       Else
36.        
37.        .Cells(n, 3).Value = ""
38.        
39.       End If
40.      
41.       If w <> .Cells(n, 5).Value Then
42.        
43.         w = .Cells(n, 5).Value
44.        
45.       Else
46.        
47.        .Cells(n, 5).Value = ""
48.        
49.       End If
50.      
51.     Next
52.    
53.   End With
54.  
55. End Sub
56.  

Gruß