Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Tabelle mit Ordner abgleichen
#1
Hallo alle zusammen  17
Ich habe mal wieder einen Auftrag bei dem ich etwas festhänge... 
Ich hoffe ihr könnt/wollt mir weiterhelfen!
Ich habe eine Excel Tabelle mit ca. 2700 Artikeln bzw. deren Bezeichnungen. Dazu passend habe ich einen Ordner mit 3200 Artikelbildern also JPG's. Die JPG's haben den selben Namen wie in der Excel Tabelle. Jetzt ist das Problem, dass die 500 Artikel überflüssig sind... Gibt es eine Möglichkeit die Excel Tabelle mit dem Ordner abzugleichen und die übereinstimmenden bzw. die nicht übereinstimmenden Bilder in einen separaten Ordner zu bewegen? Anderenfalls kann ich auch die Bilder in eine weitere Excel Tabelle einfügen, wenn das den Abgleich einfacher macht.
Danke schon mal im Voraus Smile

MfG
Alex
Antwortento top
#2
PS: 
Die Bilder müssen nicht unbedingt bewegt werden, die überflüssigen Bilder können auch gelöscht werden oder auf eine andere Weise erkenntlich gemacht werdenSmile
Antwortento top
#3
Hallo

das kleine Programm in Excel 2003 listet für jede beliebige Tabelle die man in Zelle B1 angibt alle Objekte im Blatt auf. Mit Angabe in welcher Zelle sich das Objekt befindet (Obere Linke Ecke)  Das Programm kann auch geändert werden um überflüssige Zelle auszuschneiden oder zu löschen.

Mir ist nachträgöich noch eiin Code zum löschen eingefallen, der wirksam wird, wenn man in Spalte D für das entsprechende Objekte den Text "aa" angibt.
Ich kann aber nur heute Rat geben, morgen habe ich leider kein Internet! Bei Fragen müssten bitte die Kollegen weiterhelfen.

mfg Gast 123

Code:
Option Explicit
Dim Sht As Worksheet, Blatt As String
Dim ObjName As String


Sub Objekte_löschen()
Dim Zahl As Long, j As Long
With Worksheets("Liste")
   On Error Resume Next
   Blatt = .Range("B1").Value
   Zahl = Sht.DrawingObjects.Count
   Set Sht = Worksheets(Blatt)
  
   For j = 1 To Zahl
      If .Cells(j + 2, 4) = "aa" Then
         ObjName = .Cells(j + 2, 2)
         Sht.DrawingObjects(ObjName).Delete
   Next j
End With
End Sub


Angehängte Dateien
.xls   Objekte auflisten.xls (Größe: 23 KB / Downloads: 1)
Antwortento top
#4
Hallo,

ich hatte das so verstanden:

Code:
const Bilder as string = "c:\temp\" ' <<<< anpassen >>>>

sub unnoetigeBilder()
'Namen der benötigten Bilder in Spalte A
'Ausgabe der nicht benötugten jpg's in Sheets(2)

dim rng as range
f = dir(Bilder & "*.jpg")
    set rng = columns(1).find(f,, xlvalues, xlpart)
    if rng is nothing then sheets(2).cells(rows.count,1).end(xlup).offset(1) = f
f = dir
loop
end sub

ungeprüft, kann Tippfehler enthalten

mfg
Antwortento top
#5
Hallo Smile 
Bei der Lösung mit dem Programm für Excel 2003 bin ich mir leider nicht ganz sicher ob das so funktioniert :/ 
Der Code von Fennek schaut da schon plausibler aus.
Nur leider sagt mir excel, dass bei dem Loop ein Do fehlt :/
Was müsste ich denn da noch nachtragen.

MfG 

Alex
Antwortento top
#6
ungeprüfte Code erfordern entwas Kreativität.

Einen Schritt besser:

Code:
const Bilder as string = "c:\temp\" ' <<<< anpassen >>>>

sub unnoetigeBilder()
'Namen der benötigten Bilder in Spalte A
'Ausgabe der nicht benötugten jpg's in Sheets(2)

dim rng as range

f = dir(Bilder & "*.jpg")
do while f <> vbnullstring
    set rng = columns(1).find(f,, xlvalues, xlpart)
    if rng is nothing then sheets(2).cells(rows.count,1).end(xlup).offset(1) = f
f = dir
loop
end sub
Antwortento top
#7
Hallo Smile
Sorry dass ich mich jetzt erst wieder melde. Die letzten zwei Tage war viel los...
Ich hab den Code nochmal ausprobiert und jetzt tut er es tatsächlich. Allerdings passiert nichts (oder ich sehe es zumindest nicht).
Ich hänge hier mal ein Bild der Excel-Datei an.
Vielleicht habe ich da ja was falsch verstanden   Confused 

MfG
Alex


Angehängte Dateien Thumbnail(s)
   
Antwortento top
#8
Hallo Alex,

der Code löscht keine Dateien, sondern schreibt die Namen der Dateien, die nach Prüfung im nächsten Schritt gelöscht werden sollen, in Sheets(2).

Soweit im Bild zu erkennen, gibt es in Deinem Workbook kein Sheet(2). Der Code benötigt am Ende des Pfades ein "\", es gibt aber sicher auch andere Fehlermöglichkeiten.

Wie soll man das finden, mit den sehr eingeschränkten Kommunikationsmöglichkeiten eines Forums?

mfg
Antwortento top
#9
Hallöchen,

das wäre mal ein Ansatz ohne Sheet Smile Der Code baut sich eine Collection auf, in der nur Files stehen, die es einmal gibt (nur Name ohne Extension). Die Extension lasse ich weg, weil ich nicht weiß, ob zuerst das xls oder das jpg gefunden wird und später ja nur die jpg verschoben werden sollen. Im nächsten Step müsste man die Collection durchgehen und die Dateien anhand der enthaltenen Dateinamen löschen.

Ggf. müsste man noch differenzieren, falls bei den "Einmaligen" welche dabei sein können, die nicht gelöscht werden sollen.
Wenn es verschiedene Bildformate gibt, müsste man entsprechende Varianten vorsehen.

Wenn Du einen Haltepunkt bei End Sub setzt, kannst Du schauen, was in der Collection steht und dann ggf. verschoben würde.

Code:
Sub DirVergleich()
'Variablendeklarationen
Dim colFiles As New Collection
Dim objFSO As Object, objPath As Object
Dim objFiles As Object, objFile As Object
'Objekte instanzieren
'FSO
Set objFSO = CreateObject("scripting.FileSystemObject")
'Dateipfad, anpassen!
Set objPath = objFSO.GetFolder("C:\Test\A")
'Dateien im Pfad
Set objFiles = objPath.Files
'Schleife ueber alle Dateien
For Each objFile In objFiles
  'Bei Fehler weiter
  On Error Resume Next
  'Datei der Collection hinzufuegen, Key fuer indirekte Pruefung auf Eindeutigkeit
  colFiles.Add objFSO.getbaseName(objFile.Path), objFSO.getbaseName(objFile.Path)
  'Bei Fehler (wenn der Key schon vorhanden ist), dann Eintrag loeschen
  If Err Then colFiles.Remove objFSO.getbaseName(objFile.Path)
'Ende Schleife ueber alle Dateien
Next objFile
'Hier kaeme jetzt verschieben
End Sub
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#10
Hallöchen,

interessantes Thema.  aber die Lösungsvorschläge sind nicht so sehr final. ich habe die Vorschläge mal eine bisschen zusammengefaßt.
die im Bilderordner überzähligen Bilder werden in ein anders Verzeichnis verschoben. du kanns sie auch löschen das muß du nur jeweils auskommentieren oder eben nicht . einzig die Pfade für die Ordner sind noch zu setzen. deine Exceldatei ist hoffentlich nicht im selben Ordner wie die Bilder.

Code:
Sub DirVergleich()
    'Variablendeklarationen
    Dim colFiles As New Collection
    Dim objFSO As Object, objPath As String, objPathT As String
    Dim objFiles As Object, objFile As Object
    Dim i As Long
    'Objekte instanzieren
    'FSO
    Set objFSO = CreateObject("scripting.FileSystemObject")
    'Dateipfad, anpassen!
    objPath = "bilder Pfad anpassen"
    objPathT = "Zielpfad anpassen"
   
    'Dateien im Pfad
    Set objFiles = objPath.Files
   
    ' namen+ pfad  aus tabelle in collection
    For i = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
        colFiles.Add Sheets(1).Cells(i, 1), Sheets(1).Cells(i, 1)
    Next
   
    'vergleich collection mit dateien in ordner und verschieben oder löschen
    For Each objFile In objFiles
    
      If Not Contains(colFiles, objFile.Name) Then
          objFile.Move objPathT & "\" ' achtung pfad muß mit \ enden
          'oder löschen
          'Kill (objFile)
      End If
     
    Next objFile

End Sub


Public Function Contains(col As Collection, item As String) As Boolean

    Dim i As Integer

    For i = 1 To col.Count

        If col.item(i) = item Then
            Contains = True
            Exit Function
        End If

    Next i

    Contains = False

End Function
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste