viele Dateien vergleichen und doppelte suchen

Forumthread: viele Dateien vergleichen und doppelte suchen

herbi

Hallo,
stehe vor folgender Herausforderung.
Muss Excel-Dateien miteinander Vergleichen und doppelte Artikel finden.
Alle Dateien stehen in einem Verzeichnis. (Die gesamtzahl aller Zeilen über alle Dateien = ca. 40000)
Alle Dateien haben in Spalte A bis O den identischen Aufbau, danach kommen Unterschiede.
Alle Dateien haben einen eindeutigen Key der sich aus dem Inhalt der Spalten A, C und D zusammensetzt
(Es ist eine 8 oder 13-stellige EAN, gesplittet in "Länderkennung", "Hersteller" und "Itemnummer")
Optimal wäre als Ergebnis eine Datei die für jeden mehrfach auftretenden Artikel folgendes enthält
Spalte A, C, D, O + Dateiname
geht so etwas?
herbi

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

ohne, dass ich...

Oberschlumpf
AW: viele Dateien vergleichen und doppelte suchen

Rudi

ohne, dass ich...

25.08.2010 15:09:03

Oberschlumpf

...ne Lösung weiß
Hi
Zeig uns doch mal in einer Bsp-Datei, wie genau das, was du erklärt hast, aufgebaut ist.
Weil, du hast die Datei ja schon - musst du sie uns bitte nur zeigen - und der mögliche Antworter muss deine Datei, die ja schon existiert, nicht noch mal erstellen.
Ich bin fast sicher, dass du dann vllt die eine oder andere Lösungsidee mehr erhältst.
Ciao
Thorsten

AW: viele Dateien vergleichen und doppelte suchen

25.08.2010 15:59:09

Rudi

Hallo,
in O ist der Key?

Sub ttt()
Dim sDatei As String, lngLast As Long
Dim wks As Worksheet, wksZiel As Worksheet
Dim rngDel As Range, rngC As Range
Const sPfad = "c:\test\"  'Suchpfad
Application.ScreenUpdating = False
Set wksZiel = Sheets(1)
wksZiel.Cells.Clear
sDatei = Dir(sPfad & "*.xls")
Do While sDatei  ""
Set wks = Workbooks.Open(sPfad & sDatei).Sheets(1)
lngLast = wksZiel.Cells(Rows.Count, 1).End(xlUp).Row
If lngLast > 1 Then lngLast = lngLast + 1
wks.Range("A:A,C:C,D:D,O:O").Copy wksZiel.Cells(lngLast, 1) 'Spalten kopieren
wks.Parent.Close False
With wksZiel
If lngLast > 1 Then
.Rows(lngLast).Delete
.Range(.Cells(Rows.Count, 1).End(xlUp).Offset(, 4), .Cells(lngLast, 5)) = sDatei
Else
.Cells(1, 5) = "Dateiname"
.Range(.Cells(Rows.Count, 1).End(xlUp).Offset(, 4), .Cells(lngLast + 1, 5)) = sDatei
End If
End With
sDatei = Dir
Loop
'Spalte 4 auf Unikate untersuchen und sammeln
With wksZiel
For Each rngC In .Range(.Cells(2, 4), .Cells(Rows.Count, 4).End(xlUp))
If Application.CountIf(.Columns(4), rngC) = 1 Then
If rngDel Is Nothing Then
Set rngDel = rngC
Else
Set rngDel = Union(rngDel, rngC)
End If
End If
Next
End With
'Unikate löschen
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

viele Dateien vergleichen und doppelte suchen

Forumthread: viele Dateien vergleichen und doppelte suchen

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread