Duplikate aus Tabelle entfernen

Forumthread: Duplikate aus Tabelle entfernen

14.02.2016 07:56:28

Christian

Hallo an euch alle,
ich hoffe ihr habt bei folgender Tabelle eine Lösung.
https://www.herber.de/bbs/user/103531.xlsx
Es geht mir darum, dass Stadt A als Start angesehen werden soll und die Städte in H - K als Ziele, die von dieser Stadt aus zu erreichen sind.
Es geht mir darum Verbindungen, die mehrfach vorkommen zu löschen.
die erste Verbindung ist z.B. Aachen nach Maastricht (A1;H1)
diese Verbindung kommt auch in umgekehrter Fahrtrichtung von Maastricht nach Aachen vor, (A183; I183). In diesem Fall soll "Aachen" aus der Zelle I183 gelöscht werden.
die zweite Verbindung ist z.B. Aachen nach Bonn (A1;I1)
In der Tabelle gibt es keine Verbindung von Bonn nach Aachen, also soll hier nichts geschehen.
die dritte Verbindung ist z.B. Aachen nach Lüttich (A1;J1)
In der Tabelle gibt es auch keine Verbindung von Lüttich nach Aachen, also soll auch hier nichts geschehen.
die vierte Verbindung ist z.B. Aachen nach Köln (A1;K1)
diese Verbindung kommt auch in umgekehrter Fahrtrichtung von Köln nach Aachen vor, (A155; J155). In diesem Fall soll "Aachen" aus der Zelle J155 gelöscht werden.
Hoffe das war genug an Beispielen, also wenn eine Verbindung in beiden Fahrtrichtungen in der Tabelle steht, soll sie das erste mal erhalten bleiben und die zweite Verbindung soll gelöscht werden.
Hat da jemand eine Lösung?
Viele Grüße und vielen Dank
Christian

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Duplikate aus Tabelle entfernen

14.02.2016 08:55:50

Sepp
AW: Duplikate aus Tabelle entfernen

14.02.2016 09:10:05

Christian
AW: Duplikate aus Tabelle entfernen

14.02.2016 10:04:44

Sepp
AW: Duplikate aus Tabelle entfernen

14.02.2016 20:21:36

Christian

AW: Duplikate aus Tabelle entfernen

14.02.2016 08:55:50

Sepp

Hallo Christian,

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub removeDuplikates()
Dim varA As Variant, varB As Variant, varRet As Variant
Dim lngLast As Long, lngR As Long, lngC As Long, lngI As Long

With Tabelle1 'Sheets("Tabelle1") 'Activesheet
  lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
  varA = Range("A1:A" & lngLast)
  varB = Range("H1:K" & lngLast)
  
  For lngR = 1 To UBound(varB, 1)
    For lngC = 1 To UBound(varB, 2)
      varRet = Application.Match(varB(lngR, lngC), varA, 0)
      If IsNumeric(varRet) Then
        For lngI = 1 To UBound(varB, 2)
          If varB(varRet, lngI) = varA(lngR, 1) Then varB(varRet, lngI) = ""
        Next
      End If
    Next
  Next
  .Range("H1").Resize(UBound(varB, 1), UBound(varB, 2)) = varB
End With

End Sub

Gruß Sepp

AW: Duplikate aus Tabelle entfernen

14.02.2016 09:10:05

Christian

Hallo Sepp,
danke für die Mühe, das klappt soweit.
Dürfte ich dich noch eine kleine Sache fragen? Warum ein allgemeines Modul und nicht in Tabelle1?
Gruß und schönes Wochenende
Christian

AW: Duplikate aus Tabelle entfernen

14.02.2016 10:04:44

Sepp

Hallo Christian,
natürlich kannst du den Code auch in das Modul der Tabelle stellen.

' **********************************************************************
' Modul: Tabelle1  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Sub removeDuplikates()
Dim varA As Variant, varB As Variant, varRet As Variant
Dim lngLast As Long, lngR As Long, lngC As Long, lngI As Long

With Me
  lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
  varA = .Range("A1:A" & lngLast)
  varB = .Range("H1:K" & lngLast)
  
  For lngR = 1 To UBound(varB, 1)
    For lngC = 1 To UBound(varB, 2)
      varRet = Application.Match(varB(lngR, lngC), varA, 0)
      If IsNumeric(varRet) Then
        For lngI = 1 To UBound(varB, 2)
          If varB(varRet, lngI) = varA(lngR, 1) Then varB(varRet, lngI) = ""
        Next
      End If
    Next
  Next
  .Range("H1").Resize(UBound(varB, 1), UBound(varB, 2)) = varB
End With

End Sub

Bei meinem ersten Code fehlen noch zwei Punkte (.) jeweils vor Range!

Gruß Sepp

AW: Duplikate aus Tabelle entfernen

14.02.2016 20:21:36

Christian

danke für den Hinweis
Christian

Beliebteste Forumthreads (12 Monate)

Forumthread: Duplikate aus Tabelle entfernen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread