Option Explicit
Sub v1_TabellenObjekteDupliakteEntfernen()
Dim objDataRange As Range, rngDby As Range, rngLst As Range
Dim objMyDic As Object
Dim V As Variant
Dim arrS() As Variant
   
   Set objMyDic = CreateObject("Scripting.Dictionary")
   
   'der Nährwert von abschließenden Leerzeichen der Arbeitsblatt-Namen blieb mir verborgen
   Set objDataRange = Sheets("Aufträge ").ListObjects("Tabelle1").ListColumns("Material").DataBodyRange
   For Each rngDby In objDataRange
      V = rngDby.Value
      objMyDic(V) = V
   Next rngDby
   Set objDataRange = Sheets("Angebote ").ListObjects("Tabelle13").ListColumns("Material").DataBodyRange
   For Each rngDby In objDataRange
      V = rngDby.Value
      objMyDic(V) = V
   Next rngDby
   
   arrS = objMyDic.Items()
   
   'Und dann hau ich mit dem Hämmerchen
   With Sheets("Ergebnis")
      On Error Resume Next
      With .ListObjects("Tabelle3")
         Set rngLst = .Range.Cells(1)
         .Delete
      End With
      If Err.Number <> 0 Then Set rngLst = .Range("A4")
      On Error GoTo 0
      Set rngLst = rngLst.Resize(UBound(arrS) + 1, 1)
      With rngLst
         .NumberFormat = "0"
         .Value = Application.Transpose(arrS)
      End With
      .ListObjects.Add(xlSrcRange, Range(rngLst.Address), , xlNo).Name = "Tabelle3"
   End With
'Ich übernehme keinerlei Gewähr für die Aktualität, Richtigkeit und Vollständigkeit,
'denn was interessiert mich der Schmäh', den ich vor 10 min. geschrieben habe.
'Hauptsache er war gut!
End Sub
Option Explicit
Sub v2_TabellenObjekteDupliakteEntfernen()
Dim oLstAuft As ListObject
Dim oLstAngb As ListObject
Dim oLstErgb As ListObject
Dim oLstColm As ListColumn
Dim rngDby As Range
Dim objMyDic As Object
Dim V As Variant
Dim arrS() As Variant
Dim objRange As Range, objDataRange As Range
Dim x As Long
'
  Set objMyDic = CreateObject("Scripting.Dictionary")
   'der Nährwert von abschließenden Leerzeichen der Arbeitsblatt-Namen blieb mir verborgen
   Set oLstAuft = Sheets("Aufträge ").ListObjects("Tabelle1")
   Set oLstAngb = Sheets("Angebote ").ListObjects("Tabelle13")
   Set oLstErgb = Sheets("Ergebnis").ListObjects("Tabelle3")
   
   Set oLstColm = oLstAuft.ListColumns("Material")
   For Each rngDby In oLstColm.DataBodyRange
      V = rngDby.Value
      objMyDic(V) = V
   Next rngDby
   
   Set oLstColm = oLstAngb.ListColumns("Material")
   For Each rngDby In oLstColm.DataBodyRange
      V = rngDby.Value
      objMyDic(V) = V
   Next rngDby
   
   'ohne Schlachtung
   With oLstErgb
      .DataBodyRange.Clear
      .DataBodyRange.NumberFormat = "0"
      Set objRange = .Range
      Set objRange = objRange.Resize(objMyDic.Count + 1, objRange.Columns.Count)
      .Resize objRange
   End With
   
   arrS = objMyDic.Items()
   Set oLstColm = oLstErgb.ListColumns("Spalte1")
   oLstColm.DataBodyRange.Value = Application.Transpose(arrS)
'Ich übernehme keinerlei Gewähr für die Aktualität, Richtigkeit und Vollständigkeit,
'denn was interessiert mich der Schmäh', den ich vor 10 min. geschrieben habe.
'Hauptsache er war gut!
End Sub
	  
     |