Microsoft Excel

Herbers Excel/VBA-Archiv

Gleiche Spalteninhalte zusammenführen

Betrifft: Gleiche Spalteninhalte zusammenführen von: Yasar Yüce
Geschrieben am: 22.04.2015 15:26:22

Hallo,

ich habe mehrere Tabellenblätter (ca. 20 an der Zahl) mit gleichen Spaltenbezeichnungen. Diese Spaltenbezeichnung sind aber in den einzelnen Tabellenblättern in verschiedenen Spalten zu finden. Die Inhalte aus den Spalten sollen in eine Haupttabelle zusammengeführt werden.

Also, nach gleicher Spaltenbezeichnung (Überschrift) suchen und die Inhalte der Spalten mit gleicher Bezeichnung untereinander auflisten.

Danke für die Hilfe.

Gruß,

Yasar

  

Betrifft: AW: Gleiche Spalteninhalte zusammenführen von: Nepumuk
Geschrieben am: 22.04.2015 16:23:51

Hallo,

kannst du eine Mustermappe mit 2 oder 3 Tabellen ein Paar Überschriften und ein paar Zeilen Daten hochladen? Soll das Ganze in eine neue Tabelle oder in eine der vorhandenen?

Gruß
Nepumuk


  

Betrifft: AW: Gleiche Spalteninhalte zusammenführen von: Yasar Yüce
Geschrieben am: 22.04.2015 16:43:30

https://www.herber.de/bbs/user/97242.xlsx


  

Betrifft: AW: Gleiche Spalteninhalte zusammenführen von: Nepumuk
Geschrieben am: 22.04.2015 16:46:22

Hallo,

und in welcher Tabelle sollen die 3 Tabellen zusammengefasst werden?

Gruß
Nepumuk


  

Betrifft: AW: Gleiche Spalteninhalte zusammenführen von: Yasar Yüce
Geschrieben am: 22.04.2015 16:50:50

Darf gerne eine neue Tabelle sein.


  

Betrifft: AW: Gleiche Spalteninhalte zusammenführen von: Nepumuk
Geschrieben am: 22.04.2015 17:30:05

Hallo,

teste mal:

Option Explicit

Public Sub CollectTables()
    Const COLLECTIONSHEET_NAME As String = "Zusammenfassung" 'Name der neuen Tabelle
    Dim objWorksheet As Worksheet, objCollection As Worksheet
    Dim objCell As Range
    Dim lngColumn As Long, lngInsertColumn As Long, lngInsertRow As Long
    For Each objWorksheet In Worksheets
        If objWorksheet.Name = COLLECTIONSHEET_NAME Then
            Application.DisplayAlerts = False
            objWorksheet.Delete
            Application.DisplayAlerts = True
            Exit For
        End If
    Next
    Set objCollection = Worksheets.Add(Before:=Worksheets(1))
    objCollection.Name = COLLECTIONSHEET_NAME
    For Each objWorksheet In Worksheets
        If Not objWorksheet Is objCollection Then
            With objWorksheet
                For lngColumn = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
                    Set objCell = objCollection.Rows(1).Find( _
                        What:=.Cells(1, lngColumn).Value, LookIn:=xlValues, LookAt:=xlWhole)
                    If objCell Is Nothing Then
                        lngInsertColumn = lngInsertColumn + 1
                        Call .Range(.Cells(1, lngColumn), .Cells(.Rows.Count, lngColumn).End(xlUp)).Copy( _
                            Destination:=objCollection.Cells(1, lngInsertColumn))
                    Else
                        With objCollection
                            lngInsertRow = .Cells(.Rows.Count, objCell.Column).End(xlUp).Row + 1
                        End With
                        Call .Range(.Cells(2, lngColumn), .Cells(.Rows.Count, lngColumn).End(xlUp)).Copy( _
                            Destination:=objCollection.Cells(lngInsertRow, objCell.Column))
                    End If
                Next
            End With
        End If
    Next
    objCollection.Columns.AutoFit
    Set objCollection = Nothing
    Set objCell = Nothing
End Sub

Gruß
Nepumuk


  

Betrifft: AW: Gleiche Spalteninhalte zusammenführen von: Yasar Yüce
Geschrieben am: 23.04.2015 10:50:36


Hallo Nepumuk,

SUPER!!!

Es funktioniert. :-)

Du hast mir unendlich viel Zeit eingespart.

DANKE, DANKE, DANKE!!!!

Gruß,
Yasar


 

Beiträge aus den Excel-Beispielen zum Thema "Gleiche Spalteninhalte zusammenführen"