Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1048to1052
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Verknüpfungen aktualisieren -Performance Problem-

Verknüpfungen aktualisieren -Performance Problem-
10.02.2009 15:10:24
Andreas
Hallo Miteinander,
folgende Situation. Mit dem File System Object öffne und lese ich Exceldateien aus einem Verzeichnis.
Pro geöffnete Exceldatei werden Zellenwerte an mein programmausführendes Excelsheet übertragen.
Manche geöffneten Exceldateien enthalten Verknüpfungen, die ich automatisch aktualiseren lassen möchte. Anweisung ist folgende:
If Verknuepfung = True Then
Workbooks.Open Filename:=Fileitem.Path, UpdateLinks:=Verknuepfung
Else
Workbooks.Open Filename:=Fileitem.Path
End If
Problembeschreibung:
Die Function Getmorespeed() schaltet die Zellen- /Formelberechnung aus.
Dadurch wird das Prozedere "Das Einlesen von Daten aus n-Exceldateien während der Programmausführung" extrem beschleunigt, aber die Anweisung "Workbooks.Open Filename:=Fileitem.Path, UpdateLinks:= True" nur initiiert, aber nicht ausgeführt, weil ja zuvor
Application.Calculation deaktiviert wurde.
Wird Application.Calculation separat aktiviert, verlangsamt sich die Programmausführung dramatisch.
Um das zu Umgehen, habe ich mir folgendes ausgedacht:
1) Schritt: Über fso alle Exelfiles des vorher def. Verzeichnises öffnen, Verknüpfungen aktualisieren, speichern und schliessen.
2) Schritt: Nochmal über fso alle Excelfiles öffnen, dann aber nur die Zellenwerte auslesen und an das ausführende Excelsheet die Daten übertragen.
also 1) Daten der Exelfiles aktualisieren
2) Exeldaten der Exceldateien auf das Mastersheet übertragen
Gibt es eine bessere Alternative? Wie optimiere ich die Performance?
Sub GetMoreSpeed(bYesNo As Boolean)
'Ein- bzw. Ausschalten von Excel-Aktionen
'Bildschirmaktualisierung
Application.ScreenUpdating = Not (bYesNo)
'Excel-Aktion-Methoden
Application.EnableEvents = Not (bYesNo)
'Zellen- /Formelberechnung
Application.Calculation = IIf(bYesNo, xlCalculationManual, xlCalculationAutomatic)
End Sub

Sub Read(Verknuepfung As Boolean)
Dim SourceFolderName As String
SourceFolderName = CStr(ThisWorkbook.Worksheets("Optionen").Cells(1, 1).Value)
If SourceFolderName = "" Then
MsgBox "Start-Verzeichnis fehlt, bitte selektieren!"
Exit Sub
End If
'SourceFolderName = Left(ActiveWorkbook.Path, InStrRev(ActiveWorkbook.Path, "\") - 1)
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals\Aktuelle_Proposals_DA"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals\Aktuelle_Proposals_DE"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals\Aktuelle_Proposals_DH"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals\Aktuelle_Proposals_DM"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Proposal\ _
Aktuelle_Proposals\Aktuelle_Proposals_DM\Ausgabespecial"
'SourceFolderName = "U:\LLI_TD_Cost_Reduction_Proposal\Cost_Reduction_Background_Information\ _
Veraltete_oder_gelöschte_CRP_Issues\DM"
Call ListFilesInFolder(SourceFolderName, Verknuepfung)
End Sub



Sub ListFilesInFolder(SourceFolderName As String, Verknuepfung As Boolean)
Dim fso
Dim lngRow As Long
Dim Display, URL As String
Dim IncludeSubfolders As Boolean
Dim Blattschutz As Boolean
IncludeSubfolders = True
Set Ziel = ThisWorkbook.Worksheets("CRP_Datas")
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set Sourcefolder = fso.GetFolder(SourceFolderName)
Ziel.Select
lngRow = Range("A65536").End(xlUp).Row + 1
' For 1)
For Each Fileitem In Sourcefolder.Files
'if_1
If Right(Fileitem.Name, 3) = "xls" Then
'Worksheet CRP Datas Cin ("Biodaten einlesen")
' if_2
If InStr(Fileitem.Name, "CRP_Master") > 0 Then
lngRow = lngRow - 1
Else
'On Error Resume Next
If Verknuepfung = True Then
Workbooks.Open Filename:=Fileitem.Path, UpdateLinks:=Verknuepfung
Else
Workbooks.Open Filename:=Fileitem.Path
End If
Set Quelle = ActiveWorkbook.Worksheets("Deckblatt")
Set QuelleM = ActiveWorkbook.Worksheets("Mengengerüst NRC")
'******************** -Blattschutz- ********************
If Quelle.ProtectContents = True Then
Blattschutz = True
Quelle.Unprotect Password:="CRP"
Else
Blattschutz = False
End If
'if_3
'"CRP_Aktionen" = ActiveSheet.Name
If Quelle.Name = "Deckblatt" Then
'MsgBox Fileitem.Name
'if_4
If lngRow = 6 Then
Ziel.Cells(6, 1) = 1
Else
Ziel.Cells(lngRow, 1) = Ziel.Cells(lngRow - 1, 1).Value + 1
'if_4
End If
Ziel.Cells(lngRow, 2) = Quelle.Cells(5, 3)  'Title
Ziel.Cells(lngRow, 3) = Quelle.Cells(1, 6)  'Doc. No.
Ziel.Cells(lngRow, 4) = Quelle.Cells(2, 6)  'Issue
Ziel.Cells(lngRow, 5) = Fileitem.Name       'FileItem.Name
Ziel.Cells(lngRow, 6) = Quelle.Cells(3, 6)  'Originator
Ziel.Cells(lngRow, 7) = Quelle.Cells(3, 7)  'Organization
Ziel.Cells(lngRow, 8) = Quelle.Cells(4, 6)  'Date
Ziel.Cells(lngRow, 9) = Quelle.Cells(6, 3)  'Customer
Ziel.Cells(lngRow, 10) = Quelle.Cells(6, 6) 'Project
Ziel.Cells(lngRow, 11) = Quelle.Cells(7, 3) 'Name LRU
Ziel.Cells(lngRow, 12) = Quelle.Cells(8, 3) 'Part Number
Ziel.Cells(lngRow, 13) = Quelle.Cells(9, 3) 'Article Number
Ziel.Cells(lngRow, 14) = Quelle.Cells(7, 6) 'Name Piece Part
Ziel.Cells(lngRow, 15) = Quelle.Cells(8, 6) 'Part Number
Ziel.Cells(lngRow, 16) = Quelle.Cells(9, 6) 'Article Number
Ziel.Cells(lngRow, 17) = Quelle.Cells(10, 3) 'Make / Buy / Elongated Workbench
Ziel.Cells(lngRow, 18) = Quelle.Cells(10, 6) 'Development / Serialphase
Ziel.Cells(lngRow, 19) = Quelle.Cells(13, 3) 'Specification
Ziel.Cells(lngRow, 20) = Quelle.Cells(14, 3) 'Weights
Ziel.Cells(lngRow, 21) = Quelle.Cells(15, 3) 'Cost
Ziel.Cells(lngRow, 22) = Quelle.Cells(16, 3) 'Customer approval required
Ziel.Cells(lngRow, 22 + 1) = Quelle.Cells(17, 3) 'Two Way Interchangeability
Ziel.Cells(lngRow, 23 + 1) = Quelle.Cells(13, 6) 'Maintainability
Ziel.Cells(lngRow, 24 + 1) = Quelle.Cells(14, 6) 'Reliability
Ziel.Cells(lngRow, 25 + 1) = Quelle.Cells(15, 6) 'Certification
Ziel.Cells(lngRow, 26 + 1) = Quelle.Cells(16, 6) 'Qualificvation
Ziel.Cells(lngRow, 27 + 1) = Quelle.Cells(17, 6) 'Prod. Accpt. test
Ziel.Cells(lngRow, 28 + 1) = Quelle.Cells(18, 6) 'Tech. Documentation
Ziel.Cells(lngRow, 29 + 1) = Quelle.Cells(20, 6) 'per piece part EUR
Ziel.Cells(lngRow, 30 + 1) = Quelle.Cells(20, 7) 'per piece part %
Ziel.Cells(lngRow, 30 + 2) = Quelle.Cells(21, 6) 'per LRU
Ziel.Cells(lngRow, 31 + 2) = Quelle.Cells(22, 6) 'per AC
Ziel.Cells(lngRow, 32 + 2) = Quelle.Cells(22, 3) 'per Year[EURO]
Ziel.Cells(lngRow, 33 + 2) = Quelle.Cells(19, 3) 'NRC'S[EURO]
Ziel.Cells(lngRow, 34 + 2) = Quelle.Cells(24, 3) 'Start Investment
Ziel.Cells(lngRow, 35 + 2) = Quelle.Cells(26, 3) 'Duration Investment
Ziel.Cells(lngRow, 36 + 2) = Quelle.Cells(24, 6) 'Start Amortisation
Ziel.Cells(lngRow, 37 + 2) = Quelle.Cells(25, 6) 'End Amortisation
Ziel.Cells(lngRow, 38 + 2) = Quelle.Cells(26, 6) 'Duration Amortisation
Ziel.Cells(lngRow, 39 + 2) = Quelle.Cells(27, 3) 'Performance / Specification
Ziel.Cells(lngRow, 40 + 2) = Quelle.Cells(29, 3) 'Quality Management
Ziel.Cells(lngRow, 41 + 2) = Quelle.Cells(31, 3) 'Production
Ziel.Cells(lngRow, 42 + 2) = Quelle.Cells(33, 3) 'Quality Assurance
Ziel.Cells(lngRow, 43 + 2) = Quelle.Cells(35, 3) 'Commercial
Ziel.Cells(lngRow, 44 + 2) = Quelle.Cells(37, 3) 'Human Sourcing
Ziel.Cells(lngRow, 45 + 2) = Quelle.Cells(39, 3) 'CRP to be funded by AD
Ziel.Cells(lngRow, 46 + 2) = Quelle.Cells(40, 3) 'CRP to be cancelled
Ziel.Cells(lngRow, 47 + 2) = Quelle.Cells(39, 6) 'CRP to be postponded
Ziel.Cells(lngRow, 48 + 2) = Quelle.Cells(40, 6) 'if yes: re-initation on
Ziel.Cells(lngRow, 49 + 2) = Quelle.Cells(44, 6) 'Signature Date
'Task Administration
Ziel.Cells(lngRow, 51 + 1) = Quelle.Cells(46, 3) 'AD -Number
Ziel.Cells(lngRow, 52 + 1) = Quelle.Cells(46, 6) 'Sub-Number
Ziel.Cells(lngRow, 53 + 1) = Quelle.Cells(47, 3) 'Committed Project Start
Ziel.Cells(lngRow, 54 + 1) = Quelle.Cells(47, 6) 'Committed Project Ende
Ziel.Cells(lngRow, 55 + 1) = Quelle.Cells(48, 3) 'Comm.Responsible Name
Ziel.Cells(lngRow, 56 + 1) = Quelle.Cells(49, 3) 'Comm. Responsible Departm.  Sign.
Ziel.Cells(lngRow, 57 + 1) = Quelle.Cells(49, 6) 'Comm.Date
Ziel.Cells(lngRow, 58 + 1) = Quelle.Cells(51, 6) 'Preliminary Customer Agreement  _
assured
Ziel.Cells(lngRow, 59 + 1) = Quelle.Cells(52, 3) 'Performed Project Start
Ziel.Cells(lngRow, 60 + 1) = Quelle.Cells(52, 6) 'Performed Project Ende
Ziel.Cells(lngRow, 61 + 1) = Quelle.Cells(53, 3) 'Perf.Responsible Name
Ziel.Cells(lngRow, 62 + 1) = Quelle.Cells(54, 3) 'Perf. Responsible Departm.
Ziel.Cells(lngRow, 63 + 1) = Quelle.Cells(54, 6) 'Sign.Perf.Date
'Mengengerüst auslesen
If QuelleM.Name = "Mengengerüst NRC" Then
Ziel.Cells(lngRow, 65) = QuelleM.Cells(106, 3)  'HK Material
Ziel.Cells(lngRow, 66) = QuelleM.Cells(106, 4)  'HK Fremdleistg.
Ziel.Cells(lngRow, 67) = QuelleM.Cells(111, 5)  'Project Management
Ziel.Cells(lngRow, 68) = QuelleM.Cells(111, 6)  'Entwicklung Konstruktion
Ziel.Cells(lngRow, 69) = QuelleM.Cells(111, 7)  'System-Ausl. Theorie
Ziel.Cells(lngRow, 70) = QuelleM.Cells(111, 8)  'Qualification Test
Ziel.Cells(lngRow, 71) = QuelleM.Cells(111, 9)  'Qualitätssicherung
Ziel.Cells(lngRow, 72) = QuelleM.Cells(111, 10) 'Arbeitsvorb. Fertigung
Ziel.Cells(lngRow, 73) = QuelleM.Cells(111, 11) 'Customer Service
Ziel.Cells(lngRow, 74) = QuelleM.Cells(106, 12) 'Anlagekosten Fremdl.
Ziel.Cells(lngRow, 75) = QuelleM.Cells(106, 13) 'Sonstiges Fremdl.
End If
Display = Ziel.Cells(lngRow, 3).Value
URL = Fileitem.Path
Ziel.Hyperlinks.Add Anchor:=Ziel.Cells(lngRow, 3), Address:=URL, TextToDisplay:=Display
'******************** - Blattschutz - *******************
If Blattschutz = True Then
Quelle.Protect Password:="CRP"
End If
Else
'MsgBox "No datas avaiable" & Chr(10) & Fileitem.Path
End If
'Worksheet CRP_Aktionen Cin
Dim Zeile, s, t, CRP_Master_letzte_Zeile, CRP_Anzahl_Aktionen As Integer
Set Quelle_Aktionen = ActiveWorkbook.Worksheets("Aktionen")
Set Ziel_Aktionen = ThisWorkbook.Worksheets("CRP_Aktionen")
'Ermittlung letzte Zeile Splate A Tabelle Crp Aktionen
If Quelle_Aktionen.Name = "Aktionen" Then
If Ziel_Aktionen.Cells(9, 1) = "" Then
CRP_Master_letzte_Zeile = 9
Ziel_Aktionen.Cells(9, 1) = 1
Else
CRP_Master_letzte_Zeile = EFZVUIS(Ziel_Aktionen, 1) - 1
End If
'MsgBox Quelle_Aktionen.Name
CRP_Anzahl_Aktionen = EFZVUIS(Quelle_Aktionen, 1) - 12
Zeile = CRP_Master_letzte_Zeile + CRP_Anzahl_Aktionen
If CRP_Anzahl_Aktionen > 0 Then
For k = CRP_Master_letzte_Zeile To Zeile
'Biodaten werden übetragen
Ziel_Aktionen.Cells(k, 1) = k - 8              'No.
Ziel_Aktionen.Cells(k, 2) = Quelle.Cells(5, 3) 'Title
Ziel_Aktionen.Cells(k, 3) = Quelle.Cells(1, 6) 'Doc. No.
Ziel_Aktionen.Cells(k, 4) = Quelle.Cells(2, 6) 'Issue
Ziel_Aktionen.Cells(k, 5) = Fileitem.Name      'FileItem.Name
Ziel_Aktionen.Cells(k, 6) = Quelle.Cells(3, 6) 'Originator
Ziel_Aktionen.Cells(k, 7) = Quelle.Cells(3, 7) 'Organization
Ziel_Aktionen.Cells(k, 8) = Quelle.Cells(4, 6) 'Date
Ziel_Aktionen.Cells(k, 9) = Quelle.Cells(6, 3) 'Customer
Ziel_Aktionen.Cells(k, 10) = Quelle.Cells(6, 6) 'Project
Ziel_Aktionen.Cells(k, 11) = Quelle.Cells(7, 3) 'Name LRU
Ziel_Aktionen.Cells(k, 12) = Quelle.Cells(8, 3) 'Part Number
Ziel_Aktionen.Cells(k, 13) = Quelle.Cells(9, 3) 'Article Number
Ziel_Aktionen.Cells(k, 14) = Quelle.Cells(7, 6) 'Name Piece Part
Ziel_Aktionen.Cells(k, 15) = Quelle.Cells(8, 6) 'Part Number
Ziel_Aktionen.Cells(k, 16) = Quelle.Cells(9, 6) 'Article Number
Display = Ziel_Aktionen.Cells(k, 3).Value
URL = Fileitem.Path
Ziel.Hyperlinks.Add Anchor:=Ziel_Aktionen.Cells(k, 3), Address:=URL, TextToDisplay:= _
_
Display
Next
t = EFZVUIS(Quelle_Aktionen, 1) - 1
For s = 11 To t
'Aktionen Daten Cin
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 17) = Quelle_Aktionen.Cells(s, 1) ' _
Subject
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 18) = Quelle_Aktionen.Cells(s, 2) ' _
Reference
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 19) = Quelle_Aktionen.Cells(s, 3) 'M/  _
_
A
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 20) = Quelle_Aktionen.Cells(s, 4) 'Nr. _
_
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 21) = Quelle_Aktionen.Cells(s, 5) ' _
Measure / Resulting Action
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 22) = Quelle_Aktionen.Cells(s, 6) ' _
Target
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 23) = Quelle_Aktionen.Cells(s, 7) ' _
Status / Measure of Success
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 24) = Quelle_Aktionen.Cells(s, 8) ' _
Responsible
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 25) = Quelle_Aktionen.Cells(s, 9) ' _
Department
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 26) = Quelle_Aktionen.Cells(s, 10) '  _
_
Company
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 27) = Quelle_Aktionen.Cells(s, 11) '  _
_
Issued
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 28) = Quelle_Aktionen.Cells(s, 12) '  _
_
Target
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 29) = Quelle_Aktionen.Cells(s, 13) '  _
_
Complete
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 30) = Quelle_Aktionen.Cells(s, 14) '  _
_
Priority
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 31) = Quelle_Aktionen.Cells(s, 15) '  _
_
Remarks
'Status der Aktion auslesen / gelb / rot
If Quelle_Aktionen.Cells(s, 1).Interior.ColorIndex = 4 Then ' grün
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 17).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 18).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 19).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 20).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 21).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 22).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 23).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 24).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 25).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 26).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 27).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 28).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 29).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 30).Inerior.ColorIndex = 4
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 31).Inerior.ColorIndex = 4
End If
If Quelle_Aktionen.Cells(s, 1).Interior.ColorIndex = 6 Then ' gelb
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 17).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 18).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 19).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 20).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 21).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 22).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 23).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 24).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 25).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 26).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 27).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 28).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 29).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 30).Inerior.ColorIndex = 6
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 31).Inerior.ColorIndex = 6
End If
If Quelle_Aktionen.Cells(s, 1).Interior.ColorIndex = 3 Then ' rot
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 17).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 18).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 19).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 20).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 21).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 22).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 23).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 24).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 25).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 26).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 27).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 28).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 29).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 30).Inerior.ColorIndex = 3
Ziel_Aktionen.Cells(CRP_Master_letzte_Zeile, 31).Inerior.ColorIndex = 3
End If
CRP_Master_letzte_Zeile = CRP_Master_letzte_Zeile + 1
Next
'Quelle_Aktionen = True END iF
End If
lngRow = lngRow + 1
'ActiveWorkbook.Close SaveChanges:=False
'if_3
End If
ActiveWorkbook.Close SaveChanges:=False
'if_2
End If
'if_1
End If
'For 1) Next
Next Fileitem
If IncludeSubfolders = True Then  ' Rekursiv
For Each SubFolder In Sourcefolder.SubFolders
Call ListFilesInFolder(SubFolder.Path, Verknuepfung)
Next SubFolder
End If
Set Fileitem = Nothing
Set Sourcefolder = Nothing
Set fso = Nothing
ActiveWorkbook.Saved = True
End Sub


9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
das ist Quatsch...
10.02.2009 15:23:47
Renee
Sorry Andreas,
aber (bei VBA gut?):
aber die Anweisung "Workbooks.Open Filename:=Fileitem.Path, UpdateLinks:= True" nur initiiert, aber nicht ausgeführt, weil ja zuvor Application.Calculation deaktiviert wurde.
ist Quatsch.
Ein Ausschalten der automatischen Berechnung hat sicher nicht die Auswirkung, dass die .Open Methode nicht mehr funktioniert. Führe halt nach dem .Open ein ActiveSheet.Calculate aus, oder angepasst Worksheets(x).Calculate, je nachdem welche Blätter berechnet werden sollen.
GreetZ Renée
@Renée: Willkommen zurück! oT
10.02.2009 15:29:51
heikoS
AW: das ist Quatsch...
10.02.2009 15:49:29
Andreas
Renée,
"Ein Ausschalten der automatischen Berechnung hat sicher nicht die Auswirkung, dass die .Open Methode nicht mehr funktioniert "
Es hat in der Tat keine Auswirkung. Die Open Methode funktioniert, aber durch die zusätzliche Anweisung UpdateLinks:= wird lediglich die Fensteraufforderung die Vernüpfungen zu aktualisieren oder nicht zu aktualisieren unterdrückt, aber keinesfalls ausgeführt, weil zuvor Application.calculation deaktiviert wurde.
Application.calculation hat keinen Einfluss auf die .Open Methode, aber Einfluss auf die UpdateLinks: Methode.
Gruß Andreas
Anzeige
AW: dann benutze .UpdateLink
10.02.2009 16:03:00
Renee
nach dem .Open und diesem Muster, Andreas:

Sub x()
Dim aLink
For Each aLink In ActiveWorkbook.LinkSources(xlExcelLinks)
ActiveWorkbook.UpdateLink aLink
Next
End Sub


GreetZ Renée

AW: dann benutze .UpdateLink
10.02.2009 16:35:23
Andreas
Renée,
werde das Prozedere mal einbinden. Werde anschliessend unmittelbar berichten.
Danke. Gruß Andreas
AW: dann benutze .UpdateLink
10.02.2009 18:19:00
Andreas
Renée,
das Prozedere .UpdateLink hat mich zu einer effizienteren Lösung hingeleitet.
Wenn die .open Methode ausgeführt wird, kann man dem geöffneten Excelfile explizit die Application.Calculation Anweisung zuführen.
Anbei VBA Code:
If Verknuepfung = True Then
Workbooks.Open Filename:=Fileitem.Path, updatelinks:=Verknuepfung
'Öffnet Excelfile, unterdrückt den Fensteraufruf Verknüpfungen aktualisieren, aber die Verknuepfungen werden nicht aktualisiert"
Set wb = Workbooks(Fileitem.Name)
With wb
.Application.Calculation = xlCalculationAutomatic
'Hier wird nur für das geöffnete Excelfile das Application.Calculation aktiviert.
For i = 1 To .Worksheets.Count
.Worksheets(i).Calculate
'Durch calculate werden "unter anderem" die Verknüpfungen der Tabellenblätter aktualisiert
Next
.Application.Calculation = xlCalculationManual
'Hier wird wieder alles auf den Ursprung gesetzt, und somit die Performance der Datenübertragung optimiert.
End With
Set wb = Nothing
Else
Workbooks.Open Filename:=Fileitem.Path
End If
Die Performance ist nun wieder einwandfrei.
THX
Andreas
Anzeige
AW: Verknüpfungen aktualisieren -Performance Problem-
10.02.2009 15:25:00
D.Saster
Hallo,
warum sollte die doppelte Aktion schneller sein?
Ich würde die Quelle öffnen, neu berechnen, die Daten in ein Array packen, die Quelldatei schließen, die notwendigen Daten aus dem Quellarray in ein Zielarray schreiben und das dann in die Zieltabelle.
Gruß
Dierk
AW: Verknüpfungen aktualisieren -Performance Problem-
10.02.2009 16:26:00
Andreas
Korrektur Problembeschreibung
Die Function Getmorespeed() schaltet die Zellen- /Formelberechnung aus.
Dadurch wird das Prozedere "Das Einlesen von Daten aus n-Exceldateien während der Programmausführung" extrem beschleunigt, aber die Anweisung "Workbooks.Open Filename:=Fileitem.Path, UpdateLinks:= True", das heißt die Zusatzanweisung "UpdateLinks:=" wird nur initiiert, aber nicht vollständig ausgeführt.
Nicht vollständig ausgeführt heißt,
1) Das Aufforderungungsfenster "Verknüpfungen aktualisieren" wird unterdrückt
2) Egal ob der Wert "true" oder "false" dem "UpdateLinks:=" zugewiesen wurde, es wird nicht ausgeführt.
Durch das Aktivieren der Application.Calculation verlangsamt sich das Prozedere dramatisch, aber die Anweisung "UpdateLinks:=" wird vollständig ausgeführt.
Performance:
Anzahl auszulesende Excel Dateien 184 Stück
Application.Calculation deaktiviert 1min 32secmin
Application.Calculation aktiviert ca. 30 min
Was wären Lösungen?
1) Eine vorgeschlagene Lösung wäre die Daten über ein Array auszutauschen.
Danke.
Gruß Andreas
Anzeige
Topic closed
10.02.2009 18:23:00
Andreas
Topic closed
Lösung @ Renée beschrieben.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige