Office: Prüfen ob Datei vorhanden sonst beenden + weitere Fragen

Steven82 · 29. September 2007

Hallo Leute,

ich habe in Excel 2003 folgendes Makro geschrieben.
Code:

Sub Berechnungsnachweis_umwandeln()

Application.ScreenUpdating = False 'Flimmern verhindern an

sprungmarke:
Dim sMsg As String, sPath As String
sMsg = "Wählen Sie bitte einen Ordner aus:"
sPath = getdirectory(sMsg)

Dim c As String
If sPath = "" Then
c = MsgBox("Sie haben kein Verzeichnis ausgewählt, das Programm wird beendet!", vbOKCancel)
If c = vbCancel Then
GoTo sprungmarke
Else
MsgBox "Programm wird beendet!"
Application.Quit 'Excel wird geschlossen
End
End If

End
End If

Dim b As String
b = MsgBox("Sie haben folgenden Ordner ausgewählt: " & sPath, vbOKCancel)
If b = vbCancel Then
GoTo sprungmarke
Else
MsgBox "Verzeichnis wird bearbeitet!"
End If

' durchsucht ein Verzeichnis und die Unterverzeichnisse nach Excel-Dateien
' Namens "*Berechnungsnachweis.xls", "*Berechnungsnachweis*°.xls"
' "*Berechnungsnachweis*0.xls" und speichert die Dateien; siehe ganz unten
Dim arr As Variant
Dim iCounter As Integer
arr = Array("*Berechnungsnachweis.xls", "*Berechnungsnachweis*°.xls", _
"*Berechnungsnachweis*0.xls")
For iCounter = LBound(arr) To UBound(arr)
With Application.FileSearch
.NewSearch
.LookIn = sPath
.SearchSubFolders = True
.Filename = arr(iCounter)
.Execute
For I = 1 To .FoundFiles.Count
pfad2 = .FoundFiles(I)
Workbooks.Open pfad2

'Prüfen ob Tabellenblatt "Umgewandelt" schon vorhanden
'wenn ja gehe zur nächsten Datei
'wie kann ich das machen?????

vorhanden = False
For x = 1 To Sheets.Count
If Sheets(x).Name = "Umgewandelt" Then
Sheets(x).Select
vorhanden = True
Exit For
End If
Next x
If vorhanden Then
'Text = "Arbeitsmappe enthält Tabelle Umgewandelt!"
GoTo sprungmarke2
Else
'Text = "Tabelle Umgewandelt in Arbeitsmappe nicht enthalten!"
End If
'MsgBox Text

'neues Tabellenblatt
Worksheets.Add.Move After:=ActiveSheet
ActiveSheet.Name = "Umgewandelt"

Sheets("Umgewandelt").Range("A2:V2").Select

'Spaltenbreite und -höhe
Selection.RowHeight = 37.5
Selection.ColumnWidth = 10.71

'Schriftart
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

'Hintergrundfarbe
With Selection.Interior
.ColorIndex = 36
End With

'Textausrichtung
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

'Tabellenkopf beschriften
Range("A2").Value = "Leitungs-nummer"

Range("B2").Value = "Leitung Betriebs-temp. °C"

Range("C2").Value = "Abspann-abschnitt"

Range("D2").Value = "von Mast"

Range("E2").Value = "Bauwerks-Nr."

Range("F2").Value = "bis Mast"

Range("G2").Value = "Bauwerks-Nr."

Range("H2").Value = "Objektart"

Range("I2").Value = "Höhe"

Range("J2").Value = "Station im Spannfeld"

Range("K2").Value = "Abstand vom linken Mast"

Range("L2").Value = "seitl. Abstand (+ rechts) (- links)"

Range("M2").Value = "Berechn.-temp. °C"

Range("N2").Value = "Leiterseil"

Range("O2").Value = "Zugspannung N/mm^2"

Range("P2").Value = "Ist-Abstand"

Range("Q2").Value = "VDE / EN Abstand"

Range("R2").Value = "Differenz Ist - Soll"

Range("S2").Value = "Art des Abstandes"

Range("T2").Value = "Datenauswertung durch Firma"

Range("U2").Value = "Bemerkung"

Range("V2").Value = "Erstellungsdatum"
Range("V2").ColumnWidth = 15

'Erstellungsdatum angeben
[V3] = ActiveWorkbook.BuiltinDocumentProperties.Item(11).Value

'Leer Zeilen löschen
Sheets("Berechnungsnachweis").Select
'Dim j As Long --> muss wohl nicht
For j = Range("A65536").End(xlUp).Row To 1 Step -1
If Range("A" & j).Value = "" Then Rows(j).Delete Shift:=xlUp
Next

'Textumbruch ersetzen
Dim zelle As Range
'alle Zeilen von 1 bis 3 durchsuchen
For Each zelle In Sheets("Berechnungsnachweis").Rows("1:3").SpecialCells(xlCellTypeConstants, 2)
zelle.Value = Replace(zelle, Chr(10), "") 'kleines Kästchen
zelle.Value = Replace(zelle, " ", "") 'Leerzeichen
Next
'alle belegten Zeilen in der Tabelle durchsuchen
For Each zelle In Sheets("Berechnungsnachweis").Cells(Rows.Count, 1).End(xlUp).SpecialCells(xlCellTypeConstants, 2)
zelle.Value = Replace(zelle, "°C", "") '°C
zelle.Value = Replace(zelle, "°", "") '°
Next

'1. Suche
Cells.Find(What:="Leitungs-nummer").Activate
Spalte = ActiveCell.Column 'Aktive Spalte ermitteln
zeile = ActiveSheet.Cells(Rows.Count, Spalte).End(xlUp).Row
Range(Cells(3, Spalte), Cells(zeile, Spalte)).Copy Sheets("Umgewandelt").Range("A3")

'Umformen der Leitungsnummer

'gibt die Zahl nach LH- aus
maxi = 5 'maximale Länge der Zahlen
xyz = Mid(ActiveWorkbook.Path, InStr(ActiveWorkbook.Path, "LH-") + 3, maxi)

For a = 1 To maxi
If IsNumeric(Mid(xyz, a, 1)) Then
myzahlnachLH = myzahlnachLH & Mid(xyz, a, 1)
Else
Exit For

End If
Next

'Formt die Leitungsnummer um
Dim var1 As String

Sheets("Umgewandelt").Select
zeile = 3
Spalte = 1

Do
var1 = Sheets("Umgewandelt").Cells(zeile, Spalte)
Sheets("Umgewandelt").Cells(zeile, Spalte) = ("LH-" & myzahlnachLH & "-" & var1)
zeile = zeile + 1

Loop While (Sheets("Umgewandelt").Cells(zeile, Spalte) "")
myzahlnachLH = "" ' myzahlnachLH wieder auf leer setzen

'2. Suche
Dim obgef As Range, zeile_suche As Long
With Sheets("Berechnungsnachweis")
'suche in Zeile 2 nach ~Übereinstimmung
Set obgef = .Rows(2).Find("LeitungBetriebs-temp.", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("B3")
Else

End If

'2. Suche mit anderer Schreibweise des gesuchten Wortes
Set obgef = .Rows(2).Find("Betriebs-temp.", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("B3")
Else

End If

'3. Suche
Set obgef = .Rows(2).Find("Abspann-abschnitt", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("C3")
Else

End If

'4. Suche
Set obgef = .Rows(2).Find("vonMast", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("D3")
Else

End If

'5. Suche
Set obgef = .Rows(2).Find("Bauwerks-Nr.", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("E3")
Else

End If

'6. Suche
Set obgef = .Rows(2).Find("bisMast", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("F3")
Else

End If

'7. Suche
Set obgef = .Rows(2).Find("Bauwerks-", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("G3")
Else

End If

'8. Suche
Set obgef = .Rows(2).Find("Objektart", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("H3")
Else

End If

'9. Suche
Set obgef = .Rows(2).Find("Höhe", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("I3")
Else

End If

'10. Suche
Set obgef = .Rows(2).Find("Station", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("J3")
Else

End If

'11. Suche
Set obgef = .Rows(2).Find("AbstandvomlinkenMast", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("K3")
Else

End If

'12. Suche
Set obgef = .Rows(2).Find("seitl.Abstand", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("L3")
Else

End If

'13. Suche
Set obgef = .Rows(2).Find("Berechn.-temp.", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("M3")
Else

End If

'14. Suche
Set obgef = .Rows(2).Find("Leiterseil", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("N3")
Else

End If

'15. Suche
Set obgef = .Rows(2).Find("Zugspannung", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("O3")
Else

End If

'15. Suche mit anderer Schreibweise des gesuchten Wortes
Set obgef = .Rows(2).Find("Ist-HZS", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("O3")
Else

End If

'16. Suche
Set obgef = .Rows(2).Find("Ist-Abstand", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("P3")
Else

End If

'17. Suche
Set obgef = .Rows(2).Find("VDE/EN", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("Q3")
Else

End If

'18. Suche
Set obgef = .Rows(2).Find("Differenz", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("R3")
Else

End If

'19. Suche
Set obgef = .Rows(2).Find("ArtdesAbstandes", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("S3")
Else

End If

'20. Suche
Set obgef = .Rows(2).Find("Datenauswertung", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("T3")
Else

End If

'21. Suche
Set obgef = .Rows(2).Find("Bemerkung", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("U3")
Else

End If

Set obgef = .Rows(2).Find("Bemerkungen", LookAt:=xlPart)
If Not obgef Is Nothing Then
zeile_suche = .Cells(Rows.Count, obgef.Column).End(xlUp).Row
.Range(.Cells(3, obgef.Column), .Cells(zeile, obgef.Column)).Copy Sheets("Umgewandelt").Range("U3")
Else

End If

End With

'schließt die Tabelle und speichert
ActiveWindow.Close SaveChanges:=True

sprungmarke2:
Next I

End With
Next iCounter

MsgBox Prompt:="Alle Dateien im Pfad: " & sPath & " bearbeitet!"

Application.ScreenUpdating = True 'Flimmern verhindern aus

Application.Quit 'Excel wird geschlossen

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mit diesem Makro öffne ich ein Verzeichnis aus dem ich alle Excel-Dateien mit einem bestimmten Namen öffne und bearbeite. Dies funktioniert auch super.

Meine erste Frage an Euch ist, wie kann ich das Makro beenden lassen, wenn in dem gewählten Verzeichnis keine Excel-Dateien mit dem bestimmten Namen vorhanden sind?

Meine zweite Frage ist, gibt es vielleicht noch Möglichkeiten das Makro schneller zu machen! Da ich sehr viele Excel-Dateien mit diesem Makro bearbeiten will!

Kann man sich auch irgendwie anzeigen lassen, wie lange das Makro noch arbeitet?

Vielen Dank schon Mal im Voraus!

Steven

:)

jinx · 1. Oktober 2007

Moin, Steven82,

die DIR-Funktion verwenden, die bei vorhandener Datei den Namen der Datei, ansonsten Nichts (vbNullString) zurückliefert:

Code:

If Len(Dir(C\Test.txt")) > 0 then
'weiter im Makro
Else
Exit Sub
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Application.ScreenUpdating = False schaltet die Bildschirmaktualisierung ab udn solklte ebenso wie das Umschalten auf manuelle Berechnung für die Laufdauer des Makros einen "Geschwindigkeitsschub" bingen. Am Ende bitte wieder die Aktualisierung einschalten und den Berechnungszustand auf den Ausgangsstand zurücksetzen.

Wegen der Suche: ein Array mit den Begriffen, eines mit den Zielangaben für die Ausgabe und eine Schleife würden es auch tun (ist IMHO pflegeleichter und viel einfacher zu lesen... *wink.gif* *grins

Office: Prüfen ob Datei vorhanden sonst beenden + weitere Fragen

Prüfen ob Datei vorhanden sonst beenden + weitere Fragen

Prüfen ob Datei vorhanden sonst beenden + weitere Fragen

Prüfen ob Datei vorhanden sonst beenden + weitere Fragen - Similar Threads - Prüfen Datei vorhanden

Wert aus Zelle in einer anderen Datei suchen und prüfen, ob weiterer Wert vorhanden ist

Datei vor dem verschieben prüfen, ob vorhanden

PDF-Datei löschen, Prüfen ob Datei vorhanden

Prüfen ob die Datei vorhanden und aktuell ist

Prüfen ob Datei vorhanden

speichern: prüfen, ob datei schon vorhanden

prüfen, ob Verzeichnis/Datei vorhanden ist