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

Doppelte Sätze zusammenführen

Doppelte Sätze zusammenführen
Andreas
Hallo, ich habe ein Problem mit doppelten Datensätzen, die aber unterschiedliche informationen enthalten. Wie kann ich diese zusammenführen, und danach die doppelten löschen (Am liebsten per VBA). Kann mir jemand helfen? Ein Beispiel habe ich bereits hochgeladen. Die Doppelten sind in Spalte A. Die Informationen, die benötigt werden in den Spalten F-I. Die Informationen sollen dann im Ersten Satz hinten angestellt werden (also ab Spalte J). Ich danke schon jetzt für Eure Hilfe.
Gruß Andreas
https://www.herber.de/bbs/user/74231.xls

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Doppelte Sätze zusammenführen
31.03.2011 18:03:58
Josef

Hallo Andreas,
probier mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub checkDoubleAndDelete()
  Dim rngDel As Range
  Dim lngRow As Long, lngLast As Long, lngC As Long
  Dim vntRet As Variant
  
  On Error GoTo ErrExit
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
  End With
  
  With ActiveSheet
    lngLast = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)
    
    For lngRow = 2 To lngLast
      If Application.CountIf(.Range(.Cells(2, 1), .Cells(lngRow, 1)), .Cells(lngRow, 1)) > 1 Then
        vntRet = Application.Match(.Cells(lngRow, 1), .Columns(1), 0)
        If IsNumeric(vntRet) Then
          lngC = .Cells(vntRet, .Columns.Count).End(xlToLeft).Column + 1
          .Range(.Cells(lngRow, 6), .Cells(lngRow, 9)).Copy .Cells(vntRet, lngC)
          If rngDel Is Nothing Then
            Set rngDel = .Rows(lngRow)
          Else
            Set rngDel = Union(rngDel, .Rows(lngRow))
          End If
        End If
      End If
    Next
  End With
  
  If Not rngDel Is Nothing Then rngDel.Delete
  
  ErrExit:
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
  End With
  
  Set rngDel = Nothing
End Sub


Gruß Sepp

Anzeige
AW: Doppelte Sätze zusammenführen
02.04.2011 15:20:59
Andreas
Hallo Sepp,
Vielen Dank für die schnelle Hilfe. Das ist genau was ich gesucht habe.
Gruß Andreas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige