Merhaba arkadaşlar,
İşimi oldukça hızlandıran makro programı var. Office2007 sürümüne geçiş yapıldığından dolayı kullanamıyorum. Site üzerinde bir çok konu buldum hepsini okumuş bulunmaktayım. Fakat bir türlü kullandığım makroya uygulayamadım.
Yardımcı olursanız çok sevinirim.
İşimi oldukça hızlandıran makro programı var. Office2007 sürümüne geçiş yapıldığından dolayı kullanamıyorum. Site üzerinde bir çok konu buldum hepsini okumuş bulunmaktayım. Fakat bir türlü kullandığım makroya uygulayamadım.
Yardımcı olursanız çok sevinirim.
Kod:
Sub teilen_program()
'Daten aktualisieren
'Alle Meldungen aus
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
' alle Dateien des Ordners anzeigen in Indexdatei
spf = 0
mpf = 0
Dim iCounter As Integer
Dim sPath As String
sPath = ActiveWorkbook.Path
'abbruchbedingung
If sPath = "" Then Exit Sub
With Application.FileSearch
.LookIn = sPath & "\NC_Programs\"
.Filename = "*.*"
.Execute
If .Execute > 0 Then
test2 = .FoundFiles.Count
For i = 1 To .FoundFiles.Count
'Oeffnen der Daten
ZuÖffnendeDatei = .FoundFiles(i)
Dateiname = Dir(.FoundFiles(i))
ze = 0
Open ZuÖffnendeDatei For Input As #1 'Datei in Speicher lesen
Do While Not EOF(1) 'Schleife starten bis End of file erreicht
test = LOF(1)
Line Input #1, daten 'Zeilenweise einlesen
ze = ze + 1 'Durchlaeufe Zaehlen
'Einlesen der Daten
'Einlesen der SPF
If Right(daten, 3) = "SPF" _
And Left(daten, 1) = "%" Then
sp = 5
Do While Not Mid(daten, sp, 1) = Chr(95) And sp <= Len(daten)
sp = sp + 1
Loop
programname = Mid(daten, 5, sp - 5)
spf = spf + 1
'Datei erstellen
Open sPath & "\NC_Programs\Files_SPF\" & programname & ".SPF" For Output As #2
Do While Not EOF(1) 'Schleife starten bis End of file erreicht
Print #2, daten
Line Input #1, daten 'Zeilenweise einlesen
ze = ze + 1
If Right(daten, 3) = "M17" Then
Print #2, daten
'ElseIf Right(daten, 3) = "RET" Then
'Print #2, daten
Exit Do
End If
Loop
Close #2 'neue Datei schließen
End If
'Einlesen der MPF
If Right(daten, 3) = "MPF" _
And Left(daten, 1) = "%" Then
sp = 5
Do While Not Mid(daten, sp, 1) = Chr(95) And sp <= Len(daten)
sp = sp + 1
Loop
programname = Mid(daten, 5, sp - 5)
mpf = mpf + 1
'Datei erstellen
Open sPath & "\NC_Programs\Files_MPF\" & programname & ".SPF" For Output As #2
Do While Not EOF(1) 'Schleife starten bis End of file erreicht
Print #2, daten
Line Input #1, daten 'Zeilenweise einlesen
ze = ze + 1
If Right(daten, 3) = "M30" Then
Print #2, daten
Exit Do
End If
Loop
Close #2 'neue Datei schließen
End If
Loop
'Datei zum einlesen schließen
Close #1
Next i
End If
End With
'Alle Meldungen an
Application.EnableEvents = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox ("Einlesen erfolgreich. " & spf & " Unterprogramme verarbeitet " & mpf & " Hauptprogramme verarbeitet")
End Sub
Ekli dosyalar
-
42.5 KB Görüntüleme: 8