Doppelte Artikelnummern sortieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Marcel,
so sollte es funktionieren - die beiden Dateien werden im gleichen Verzeichnis erwartet, aus den beiden Dateien stehen die Artikelnummern in Tabelle(1) in Spalte B ab Zeile 2
In der empfangenden Mappe, in die auch das Makro (in ein allgemeines Modul) gehört, werden die Artikelnummern in Tabell1 in der Spalte 1 ausgegeben und aufsteigend sortiert.

Option Explicit
'
'   folgendes Problem:
'
'   Ich habe 2 verschiedene Arbeitsmappen mit sehr vielen Kundennummern.
'   Einige Kundennummern gleichen sich in beiden Arbeitsmappen, einige Kundennummern
'   sind nur in einer der beiden Arbeitsblätter vorhanden.
'
'   Gibt es eine Möglichkeit in einer weiteren Arbeitsmappe alle Kundenummern genau
'   einmal darzustellen ohne eine doppelte Kundennummer?
'
Public Sub Artikel_Nr()
Dim WkSh       As Worksheet  ' Das Tabellenblatt zur Aufnahme der Artikel-Nummern
Dim appExcel   As Object     ' die Excel-Application
Dim objDict    As Object     ' das Scripting.Dictionary
Dim objMappeV  As Object     ' die jeweilige Fremddatei mit den Artikel-Nummern
Dim Pfad       As String     ' der Pfad der Fremddateien
Dim Datei      As Variant    ' der Array mit den Namen der Fremddateien
Dim iIndex     As Integer    ' der For/Next Schleifen-Index zum Array
Dim lZeile_Q   As Long       ' die Zeile in den Fremddateien
Dim lZeile_Z   As Long       ' die Zeile in der Ziel-Datei
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
'
   Set appExcel = CreateObject("Excel.Application")
   Set objDict = CreateObject("Scripting.Dictionary")
   On Error GoTo Nachricht
   Set WkSh = ThisWorkbook.Worksheets("Tabelle1")
   WkSh.Columns(1).ClearContents
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
'                               anpassen!!!!!!!!!!                               '
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
   Pfad = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\" & _
      "Excel-Dateien\"
   Datei = Array("Datei I.xls", "Datei II.xls") ' Datei 1 und Datei 2
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
   For iIndex = LBound(Datei) To UBound(Datei)
      Set objMappeV = appExcel.Workbooks.Open(Pfad & Datei(iIndex))
      With objMappeV.Sheets(1)     ' die fremde Mappe Tabelle(1)
'           die fremde Datei Spalte 2 = B ab Zeile 2
         For lZeile_Q = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
'              leere Zellen nicht kopieren/anzeigen
            If Not .Cells(lZeile_Q, 2).Value = "" Then
'              hier werden die doppelten Einträge eliminiert
               If Not objDict.exists(.Cells(lZeile_Q, 2).Value) Then
                  Call objDict.Add(.Cells(lZeile_Q, 2).Value, Empty)
'                    hier werden die Daten in das Tabellenblatt1 eingestellt
                  lZeile_Z = lZeile_Z + 1
                  WkSh.Cells(lZeile_Z, 1) = .Cells(lZeile_Q, 2).Value
               End If
            End If
         Next lZeile_Q
      End With
      objMappeV.Close
   Next iIndex
   Set appExcel = Nothing
'
'     sortieren der übernommenen Artikelnummern
'
   WkSh.Columns("A:A").Sort _
       Key1:=WkSh.Range("A1"), Order1:=xlAscending, _
       Header:=xlNo, OrderCustom:=1, _
       MatchCase:=False, Orientation:=xlTopToBottom
   Exit Sub
Nachricht:
   On Error Resume Next
   Set appExcel = Nothing
   MsgBox Err.Number & ": " & Err.Description
End Sub

Gruß Peter

Beliebteste Forumthreads (12 Monate)

Doppelte Artikelnummern sortieren

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread