CanUndo = False spart keine Ressourcen?!!

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox


Excel-Version: 97
nach unten

Betrifft: CanUndo = False spart keine Ressourcen?!!
von: Maria
Geschrieben am: 06.05.2002 - 15:19:47

Werte Gemeinde!

Ich sitze hier immer noch händeringend über dem gleichen Problem. Über eine Schleife muß ich nacheinander auf verschiedene Werte filtern und das Gefilterte zwecks Auswertung in ein anderes Sheet rüberkopieren. Obwohl es jeweils nicht viele Datensätze sind (so je 30-50), geht mir der Rechner ab dem 3ten bis 5ten Durchlauf in die Knie, erst low on virtual memory, dann gar kein Memory mehr => Ende.

Jetzt kam ich auf den Gedanken, undo zu disabeln, um Ressourcen zu sparen. Bringt nur leider gar nichts.

Habe ich die falsche Methode erwischt? Oder gibt es noch irgendwelche anderen Ansätze, wie ich mit äußerst mageren Ressourcen (128 MB RAM, Swap-Datei kann nicht verändert werden) mehrere Copy & Paste-Durchgänge unfallfrei nacheinander durchlaufen lassen kann?

So langsam verzweifel ich wirklich... :-////

nach oben   nach unten

Re: CanUndo = False spart keine Ressourcen?!!
von: rainer
Geschrieben am: 06.05.2002 - 15:35:27

Hallo! Ich bin mir nicht so recht sicher, ob dir das helfen wird, aber probieren kannst dus ja mal:
setze am Anfang deines Makros
application.enableevents=false (wenn möglich)
application.calculation=xlmanual

und am Ende
application.enableevents=true (wenn möglich)
application.calculation=xlautomatic

Hoffe das hilft
Rainer

nach oben   nach unten

Re: CanUndo = False spart keine Ressourcen?!!
von: Hajo
Geschrieben am: 06.05.2002 - 15:44:14

Hallo

es haben nicht alle Deine Dikussion intensiv verfogt. Vielleicht wäre es sinnvoll den Code ins Forum zu stellen.

Gruß Hajo


nach oben   nach unten

Code nachgereicht - vorsicht! länglich
von: Maria
Geschrieben am: 06.05.2002 - 15:52:17

___________________________________________________________
Sub Sort_by_Division()

'****************************************************************
' Laeuft noch nicht so wie's soll. Ressourcen-Probs...
'****************************************************************


Dim objDiviFind As Object
Dim rngDiviAdr As Range
Dim strDiviAdr As String
Dim intDiviCol As Integer
Dim colValues As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
Dim strTemplate As String
Dim strStratPath As String
Dim dtoNothing As DataObject

Set dtoNothing = New DataObject

'determine the correct path
strStratPath = accessdirectory("Root") + accessdirectory("General_Sheets")

MsgBox strStratPath

'richtige Excel-Datei aktivieren
Windows("source_bearbeitet_" + Format(Date, "yymmdd") + ".xls").Activate
'Achtung! Muss schon geoeffnet sein, ist es aber eigentlich.

'richtiges Worksheet aktivieren
Sheets("Report").Select


'zuerst die Sicherheitsabfrage, wo das Gewuenschte ist
'starting point
Rows("1:1").Select
Rows("1:1").Select
Range("A1").Activate

Set objDiviFind = ActiveSheet.Rows(1).Find(What:="Reporting Division", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
objDiviFind.Select

strDiviAdr = objDiviFind.Address
intDiviCol = objDiviFind.Column

'Sorting
Selection.Sort Key1:=Range(strDiviAdr), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next

Cells(strDiviAdr).Select
For Each Cell In Range(Selection, Selection.End(xlDown))
colValues.Add Cell.Value, CStr(Cell.Value)

' Note: the 2nd argument (key) for the Add method must be a string
Next Cell

' Resume normal error handling
On Error GoTo 0

' Sort the collection (optional)
For i = 1 To colValues.Count - 1
For j = i + 1 To colValues.Count
If colValues(i) > colValues(j) Then
Swap1 = colValues(i)
Swap2 = colValues(j)
colValues.Add Swap1, before:=j
colValues.Add Swap2, before:=i
colValues.Remove i + 1
colValues.Remove j + 1
End If
Next j
Next i


For i = 1 To colValues.Count

If colValues.Item(i) <> "Reporting Division" Then
MsgBox colValues.Item(i)

'Filter by item

'Filter
ActiveSheet.UsedRange.AutoFilter
ActiveSheet.UsedRange.AutoFilter field:=intDiviCol, Criteria1:=colValues.Item(i)

'********************************
MsgBox colValues.Item(i) & " wurde gefiltert"

'********************************

'Disable undo for saving ressources
CanUndo = False

'select all
Cells.Select

Application.Wait Now + TimeSerial(0, 1, 0)

'Copy
Application.CutCopyMode = False
Selection.SpecialCells(xlVisible).Copy

'********************************
MsgBox colValues.Item(i) & " wurde kopiert."
'********************************


'create temporary sheet
'templates with names other than their respective entrance

Select Case colValues.Item(i)

Case "ICT"
strTemplate = "Intercity_trains"
Case "APM"
strTemplate = "TTS"
Case "LRT"
strTemplate = "TTS"
Case "ATS"
strTemplate = "TTS"
Case "INB"
strTemplate = "IN+"
Case "INC"
strTemplate = "IN+"
Case Else
strTemplate = colValues.Item(i)

End Select



On Error Resume Next

Windows("source_bearbeitet_" + Format(Date, "yymmdd") + ".xls").Activate
Worksheets("tmp_" & strTemplate).Select
If Err.Number <> 0 Then
Worksheets.Add
ActiveSheet.Name = "tmp_" & strTemplate
End If
On Error GoTo 0


'********************************
MsgBox colValues.Item(i) & " - temporäres Sheet wurde erstellt."
'********************************


'Pause
Application.Wait Now + TimeSerial(0, 2, 0)

'frueher hier zurueck zum normalen Errorhandling,
'testweise nach unten

'Prepare Paste
Sheets("tmp_" & strTemplate).Activate
ActiveSheet.Range("A1").Select


'Pause
Application.Wait Now + TimeSerial(0, 2, 0)

'Paste
Sheets("tmp_" & strTemplate).Paste
Application.CutCopyMode = False


'********************************
MsgBox colValues.Item(i) & " wurde pastiert."
'********************************

'Back to normal error handling
On Error GoTo 0
Application.DisplayAlerts = True

'Defilter
Windows("source_bearbeitet_" + Format(Date, "yymmdd") + ".xls").Activate
Sheets("Report").Activate
ActiveSheet.ShowAllData
Selection.AutoFilter

Application.Wait Now + TimeSerial(0, 2, 0)



End If

Next i

MsgBox "Fertig!!!!!!!"

End Sub

_____________________________________________________

Sobald ich BTW zwischendrin versucht habe, die Speichernutzung auszugeben, hat er meinen Zähler wieder vergessen...

So, ich hoffe das hilft Euch beim Helfen...

nach oben   nach unten

enableevents und calculation?
von: Maria
Geschrieben am: 06.05.2002 - 16:02:38

Erstmal danke!

Die Hilfe ist nicht wirklich auskunftsfreudig, was die von Dir vorgeschlagene Lösung betrifft. Was genau bewirkt das Ganze?


nach oben   nach unten

Re: enableevents und calculation?
von: rainer
Geschrieben am: 06.05.2002 - 16:10:42

Hallo Maria! Sorry...werde ich jetzt nachholen:
Mit Application.calculation=xlmanual schaltest du auf manuelles Berechnen um. Das hat den Vorteil, daß z.B. bei 1000 Zelländerungen nicht nach jeder Zelländerung gerechnet wird, sondern nur auf Anforderung. Mit Application.calculation=xlautomatic wird wieder auf automnatisches Berechnen umgeschaltet, also wird nur einmal Kalkuliert (in Summe)
Mit Application.enableevents=false (bzw True) schaltest du die Ereigniskopplung aus bzw wieder an. Dadurch werden Makros, die durch Ereignisse wie z.B. Blattwechsel oder ähnliches ausgelöst werden, nicht aufgerufen. Dazu müßtest du aber einen Code in bestimmte Module geschrieben haben.

Ich hoffe ich konnte es verständlich erklären
Gruß
rainer

nach oben   nach unten

Ah ja
von: Maria
Geschrieben am: 06.05.2002 - 16:18:21

Danke für die Erklärungen. Sieht so aus als bräuchte ich nur ersteres (sind nämlich keine automatisch ablaufenden Events vorgesehen, zumindest nicht meinerseits), und es liest sich als ob das wirklich was bringen könnte. Hab es jetzt mal probeweise eingebastelt und schaue, wie weit ich komme.

nach oben   nach unten

Re: Code nachgereicht - vorsicht! länglich
von: Hajo
Geschrieben am: 06.05.2002 - 16:21:30

Hallo Maria

bei mir wird der Code nicht kompiliert
Fehler


    Dim dtoNothing As DataObject
    Set dtoNothing New DataObject


und bei auskommentieren nächstze Zeile
    strStratPath = accessdirectory("Root") + accessdirectory("General_Sheets")

Variable Cell ist nicht Definiert bei 
    For Each Cell In Range(Selection, Selection.End(xlDown))

ich würde Cell auch nicht als Variable nehmen

nächste Zeile die nicht kompiliert wird 
            CanUndo = False

Mein erster Eindruck ich würde auf select verzichten.

Gruß Hajo


nach oben   nach unten

Bringt leider nix
von: Maria
Geschrieben am: 06.05.2002 - 16:50:50

Steigt genau an der gleichen Stelle aus. :-(((
nach oben   nach unten

Re: Code nachgereicht - vorsicht! länglich
von: Maria
Geschrieben am: 06.05.2002 - 16:51:58

Das mit dtoNothing ist doch auch rauskommentiert - dachte ich hätte das auch rausgelöscht in der Version die rausging. War ein Test, um die Zwischenablage etwas gründlicher zu reinigen - hat mir aber leider meinen Zähler beseitigt. :-(

Die Fehlermeldung mit Cell kommt bei mir (Excel 97) nicht.

Wo würdest Du auf select verzichten?

nach oben   nach unten

Re: Code nachgereicht - vorsicht! länglich
von: Hajo
Geschrieben am: 06.05.2002 - 16:59:37

Hallo Maria

mir ist der Code nicht ganz klar aber mal als Ansatz


'   richtige Excel-Datei aktivieren
'    Windows("source_bearbeitet_" + Format(Date, "yymmdd") + ".xls").Activate
''   Achtung! Muss schon geoeffnet sein, ist es aber eigentlich.
''   richtiges Worksheet aktivieren
'    Sheets("Report").Select
''   zuerst die Sicherheitsabfrage, wo das Gewuenschte ist
''   starting point
'    Rows("1:1").Select
'    Range("A1").Activate
    With Workbooks("source_bearbeitet_" + Format(Date, "yymmdd") + ".xls").Worksheets("Report")
        Set objDiviFind = .Rows(1).Find(What:="Reporting Division", LookIn:=xlValues, LookAt:=xlPart, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext)
        objDiviFind.Select
    
        strDiviAdr = objDiviFind.Address
        intDiviCol = objDiviFind.Column
    
'   Sorting
        .Rows(1).Sort Key1:=Range(strDiviAdr), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With


Gruß Hajo

nach oben   nach unten

With?
von: Maria
Geschrieben am: 06.05.2002 - 17:03:45

Verzeih mir meine Unkenntnis, aber warum das with? Was kann das was mein Code bisher nicht kann? Und spart das Ressourcen?

(Ist mir klar, dass der Code nicht per se verständlich ist. Stammt aus einem größeren Projekt zur Automatisierung mehrerer Arbeitsschritte.)


nach oben   nach unten

Re: With?
von: Hajo
Geschrieben am: 06.05.2002 - 17:17:31

Hallo Maria

mit dem With wird das Select gespart man kann schreiben
Workbooks("source_bearbeitet_" + Format(Date, "yymmdd") + ".xls").Worksheets("Report").Range("A2")=123
Workbooks("source_bearbeitet_" + Format(Date, "yymmdd") + ".xls").Worksheets("Report").Range("A5")=1239
Workbooks("source_bearbeitet_" + Format(Date, "yymmdd") + ".xls").Worksheets("Report").Range("A6")=12398
Workbooks("source_bearbeitet_" + Format(Date, "yymmdd") + ".xls").Worksheets("Report").Range("A7")=123984

oder noch auführlicher erst Datei  wählen mit Select, dann Register und zum Schluß noch die Zelle


Oder
With Workbooks("source_bearbeitet_" + Format(Date, "yymmdd") + ".xls").Worksheets("Report")
    .Range("A2")=123
    .Range("A5")=1239
    .Range("A6")=12398
    .Range("A7")=123984
End With

Es wird keine Rechenleistung für den Bildschirmaufbau benötigt da kein select und ich finde die zweite Schreibweise doch ein wenig übersichtlicher.

Gruß Hajo


nach oben   nach unten

Versteh ich nich, sorry...
von: Maria
Geschrieben am: 06.05.2002 - 17:51:21

Vielleicht sitze ich schon zu lange vorm Bildschirm mit zu viel Chaos drauf und drumerherum, vielleicht bin ich auch einfach zu blöd. Jedenfalls weiß ich immer noch nicht, worauf Du raus willst.

Kein Bildschirmaufbau hört sich gut an. Das kann man aber doch irgendwie generell aushebeln, egal bei was, oder?

Ich versteh bloss immer noch nicht, auf welchen Teil meines Codes Du Dich beziehst. Auf irgendein "Cells.Select"? Auf mein "Select case"?

Sorry, ich steh ziemlich auf dem Schlauch...


nach oben   nach unten

Re: Versteh ich nich, sorry...
von: Hajo
Geschrieben am: 06.05.2002 - 17:59:16

Hallo Maria

das war nur ein Beispiel das Cedebeispiel in einem der vorherigen Beiträge bezog sich auf den Beginn Deines Makros.

Es stimmt schon das man den Bildschirmaufbau mit
application.screenupdating = false

abschalten kann. Aber trotsdem sollte auf select verzichtet werden. Ich habe es nun noch nicht getestet was schneller ist
-ohne Select
- oder mit application.screenupdating = false

Gruß Hajo


nach oben   nach unten

Screenupdating = false bringt nix, Select unklar
von: Maria
Geschrieben am: 07.05.2002 - 10:22:03

Hab es zuerst einmal mit Application.ScreenUpdating = false versucht. Er ließ einige wegklickbare Fehlermeldungen zwischendurch aus - aber ansonsten ging genau an der gleichen Stelle wie vorher auch nichts mehr.

Mit dem Select versuch ich auch noch nach 8h Schlaf zu verstehen, was Du mir eigentlich sagen willst. (Sorry, aber vielleicht komme ich als Historikerin doch nicht immer in allen Punkten uneingeschränkt mit, auch wenn ich mich für ziemlich computerliterat halte...)

Meinst Du dass ich statt:

Workbooks("MyWorkbook").Select
Sheets("MySheet").Activate (oder .Select)
Function (Optionen)

folgendes schreiben sollte:

Workbooks("MyWorkbook").Sheets("MySheet").Function (Optionen)

???

Oder noch etwas anderes? Dann bitte, bitte, bitte noch mal mit anderen Worten erklären, auf daß ich es irgendwann einmal endlich kapiere...

Danke!



 nach oben

Beiträge aus den Excel-Beispielen zum Thema ".dbf Dateien öffnen"