Probleme mit

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Text_löschen() Dim AC As Range, lz1 As Long Application.ScreenUpdating = False lz1 = Cells(Rows.Count, "A").End(xlUp).Row 'Schleife zum abschneiden des letzten Wortes For Each AC In Range("A1:A" & lz1) AC.Value = Trim(Left(AC, InStrRev(AC, " "))) Next AC End Sub

Sub Text_vergleichen() Dim AC As Range, lz1 As Long Dim VTxt As String, n As Long Application.ScreenUpdating = False 'Vergleichstext aus Sheet xxx Range yyy laden VTxt = Worksheets("Tabelle xxx").Range("yyy") VTxt = Trim(Left(VTxt, InStrRev(VTxt, " "))) lz1 = Cells(Rows.Count, "A").End(xlUp).Row 'Schleife zum Prüfen des Vergleichstextes For Each AC In Range("A1:A" & lz1) If InStr(AC, VTxt) Then n = n + 1 Next AC MsgBox n & " ZählenWenn gefunden" 'Ergebnis in Zieltabelle xxx range yyy speichern Worksheets("Tabelle xxx").Range("yyy") = n End Sub

=WENN(G2>=EDATUM(HEUTE();-360);"X";"MRS "&TEXT(I2;"00000")&" "&WECHSELN(WECHSELN(WECHSELN(WECHSELN(B2;":";"");"?";"");"/";"");"*";"")&" ("&TEXT(C2;"TT.MM.JJJJ")&") - "&E2&" ("&TEXT(F2;"TT.MM.JJJJ")&") "&G2&"-"&H2)

Public Sub DateienAuflisten() Dim blnFound As Boolean Dim lngZeile As Long Dim objFileSystem As Object Dim objVerzeichnis As Object Dim objDateienliste As Object Dim objDatei As Object Dim objDrives As Object Dim objDrive As Object Application.Calculation = xlCalculationManual Sheets("Dateien").Cells.Clear Set objFileSystem = CreateObject(Class:="Scripting.FileSystemObject") Set objVerzeichnis = objFileSystem.GetFolder("D:\Bilder") Set objDateienliste = objVerzeichnis.Files For Each objDatei In objDateienliste If objDatei.Name Like "MRS*" Then lngZeile = lngZeile + 1 'Nur Bilder mit Endung 1.jpg auflisten If InStr(objDatei.Name, " 1.jpg") Then _ Cells(lngZeile, 1) = objDatei.Name End If Next objDatei Set objDrives = objFileSystem.Drives For Each objDrive In objDrives If objDrive.DriveLetter = "F" Then blnFound = True Set objDrive = Nothing Exit For End If Next If blnFound Then lngZeile = 0 Set objVerzeichnis = objFileSystem.GetFolder("E:\Bilder") Set objDateienliste = objVerzeichnis.Files For Each objDatei In objDateienliste lngZeile = lngZeile + 1 'Nur Bilder mit Endung 1.jpg auflisten ** If InStr(objDatei.Name, " 1.jpg") Then _ Cells(lngZeile, 1) = objDatei.Name Next objDatei End If 'Alle Endungen in Spalte A mit Replace löschen ** Columns(1).Replace " 1.jpg", "", xlPart Set objDrives = Nothing Set objVerzeichnis = Nothing Set objDateienliste = Nothing Set objFileSystem = Nothing Application.Calculation = xlCalculationAutomatic End Sub

zu meiner Verteidigung,
du sagst selbst, Ideen die nichts mit der Aufgabenstellung zu tun haben. Die Infos die ich gegeben habe, haben ausgereicht um ohne Rückfrage innerhalb einer Stunde eine Antwort zu erhalten, wozu dann ein Fass aufmachen und von solch riesigen, wohlbermerkt 100% funktionierenden, Projekten erzählen? Das hätte doch nur zur Verwirrung geführt was ich jetzt eigentlich will und hätte bedeutet dass sich der Helfer in all diese komplexen Strukturen reindenkt, ohne dass es notwendig gewese wäre....
Aber ich erinnere mich auch nur daran dass du es warst weil du ne Kommentarzeile mit deinem Namen und dem Datum eingefügt hast.
Aber jetzt zu dem Makro, auf jeden Fall ein guter Ansatz aber ich befürchte da haben wir das Beispiel, wo die Frage der Komplexität und dem was ich dafür brauche voll einschlägt.
Aber zu allererst, es funktioniert ohne Fehlermeldung.
nur
1. was habe ich von den ganzen Leerzellen, das würde ja an der Anzahl der Zählenwenn Formeln die ich brauche nichts ändern, nur an dem Inhalt der verglichen werden soll...
2. es macht keinen Sinn, das Abschneiden des letzten Wortes auch auf Spalte B anzuwenden (davon war meinerseits auch nie die Rede), da die Dateinamen in diesem Ordner sowieso nur einmal vorkommen und deshalb auch keine laufende Nummer haben. Außerdem wird die Spalte B sowieso nur befüllt wenn ich vorher mich bequemt hab den USB Stick vom TV abzuziehen und in den Laptop zu stecken.
3. ich hatte ja noch nachgereicht, dass ich für ne andere Stelle der Riesenmappe auch die bisherige Version der Dateiliste brauche, mir würde also nur ein Makro helfen, dass sowohl eine Spalte mit dem bisherigen Inhalt als auch eine Spalte mit deinem neuen Inhalt erstellt.
Gruß
Christian

Hallo Christian
Sorry, deine Reaktion verwirrt mich jetzt sehr!? - Wieso Verteidigung, das verstehe ich nicht? - Ich hatte nicht vor dich anzugreifen!
In den vielen Jahren Forum Arbeit erlebe ich immer wieder das sich Threads dynamisch entwickeln, und Lösungen in ganz andere Richtungen gehen.
Weil ich das Makro hier nicht testen konnte fiel mir der Leerzeilen Fehler nicht auf. Dummer kleiner Programmierfehler, aber Excel reagierte korrekt darauf.
Das angehängte Makro sollte, wenn alles klappt, dir zwei getrennte Spalten auflisten. In Spalte A die bisherige Original Version. In Spalte D meine geänderte Version.
Die Spalte für meine Version kannst du selbst einstellen. Bei Const steht ja: Const SpX = "D". Du kannst Buchstaben "D" in jede andere Spalte ändern.
Würde mich freuen wenn dir diese Änderung weiterhilft.
mfg Piet

Const SpX = "D" 'Spalte für "1.jpg" Endung


Public Sub DateienAuflisten()
Dim lngZeileX As Long   '** neu eingefügt
Dim blnFound As Boolean
Dim lngZeile As Long
Dim objFileSystem As Object
Dim objVerzeichnis As Object
Dim objDateienliste As Object
Dim objDatei As Object
Dim objDrives As Object
Dim objDrive As Object
Application.Calculation = xlCalculationManual
Sheets("Dateien").Cells.Clear
Set objFileSystem = CreateObject(Class:="Scripting.FileSystemObject")
Set objVerzeichnis = objFileSystem.GetFolder("D:\Bilder")
Set objDateienliste = objVerzeichnis.Files
For Each objDatei In objDateienliste
If objDatei.Name Like "MRS*" Then
lngZeile = lngZeile + 1
Cells(lngZeile, 1) = objDatei.Name
'Nur Bilder mit Endung 1.jpg in Spalte D auflisten
If InStr(objDatei.Name, " 1.jpg") Then
lngZeileX = lngZeileX + 1
Cells(lngZeileX, SpX) = objDatei.Name
End If
End If
Next objDatei
Set objDrives = objFileSystem.Drives
For Each objDrive In objDrives
If objDrive.DriveLetter = "F" Then
blnFound = True
Set objDrive = Nothing
Exit For
End If
Next
If blnFound Then
lngZeile = 0
lngZeileX = 0
Set objVerzeichnis = objFileSystem.GetFolder("E:\Bilder")
Set objDateienliste = objVerzeichnis.Files
For Each objDatei In objDateienliste
lngZeile = lngZeile + 1
Cells(lngZeile, 1) = objDatei.Name
'Nur Bilder mit Endung 1.jpg auflisten
If InStr(objDatei.Name, " 1.jpg") Then
lngZeileX = lngZeileX + 1
Cells(lngZeileX, SpX) = objDatei.Name
End If
Next objDatei
End If
'Alle Endungen in Spalte A mit Replace löschen
'## Wenn nicht gewünscht diesen Befehl löschen!!
Columns(SpX).Replace " 1.jpg", "", xlPart
Set objDrives = Nothing
Set objVerzeichnis = Nothing
Set objDateienliste = Nothing
Set objFileSystem = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub

Beliebteste Forumthreads (12 Monate)

43 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

43
Beiträge zum Forumthread

Beiträge zu diesem Forumthread