Microsoft Excel

Herbers Excel/VBA-Archiv

Code sorgt für 99%CPU Last und endet nicht?!?

Betrifft: Code sorgt für 99%CPU Last und endet nicht?!? von: Lauren
Geschrieben am: 12.08.2008 14:04:19

Hallo zusammen

folgender code bewirkt eine Art Endlosschleife jemand ne Idee woran das liegen könnte, übersehe ich hier etwas?!?!

Range("M2").Select
ActiveCell.FormulaR1C1 = "=IF(COUNTIF(C[-12],RC[-12])>=3,RC[-3]*RC[-9],"""")"
Selection.AutoFill Destination:=Range("M2:M" & Range("M2").End(xlDown).Row), Type:= _
xlFillDefault

Columns("M:M").EntireColumn.AutoFit



hier sehe ich auch berechnete Werte aber dann


' AVG Weight Streckengewichtet Produkt 1
Range("N2").Select
ActiveCell.FormulaR1C1 = "=IF(COUNTIF(C[-13],RC[-13])>=3,RC[-3]*RC[-10],"""")"
Selection.AutoFill Destination:=Range("N2:N" & Range("N2").End(xlDown).Row), Type:= _
xlFillDefault

Columns("N:N").EntireColumn.AutoFit



kommt zu keinem Ende ich will ja nur, dass er die formle nimmt und bis zur letzten Beschriebenen Zeile ausfüllt, geht es in diesem Fall bis zur aller letzten Zeile vom aktivem sheet oder was läuft falsch??!?!?

Danke!!!

  

Betrifft: AW: Code sorgt für 99%CPU Last und endet nicht?!? von: Rudi Maintaire
Geschrieben am: 12.08.2008 14:11:36

Hallo,

geht es in diesem Fall bis zur aller letzten Zeile vom aktivem sheet


so ist es.

Bis ans Ende von L:
Selection.AutoFill Destination:=Range("M2:M" & Range("L2").End(xlDown).Row), Type:= _
xlFillDefault

Gruß
Rudi


  

Betrifft: AW: Code sorgt für 99%CPU Last und endet nicht?!? von: Daniel
Geschrieben am: 12.08.2008 14:35:51

Hi

wie Rudi schon richtig gezeigt hat, es macht keinen Sinn, die Anzahl der Zeilen in der spalte zu prüfuen, die du gerade befüllen willst, weil diese Spalte ja normalerweise leer ist.

Außerdem, Autofill ist in VBA eine fast überflüssige Funktion.
Folgendes funktioniert genauso:

Dim Zeilen as long
Zeilen = Cells(rows.count,1).end(xlup).row 'hier eine Spalte wählen,die auf jeden Fall gefüllt  _
ist
Range("M2:M" & Zeilen).FormulaR1C1 = "=IF(COUNTIF(C[-12],RC[-12])>=3,RC[-3]*RC[-9],"""")"
Range("N2:N" & Zeilen).FormulaR1C1 = "=IF(COUNTIF(C[-13],RC[-13])>=3,RC[-3]*RC[-10],"""")"


in deinem Fall lässt es sich aber noch weiter reduzieren:

Zeilen = Cells(rows.count,1).end(xlup).row 
Range("M2:N" & Zeilen).FormulaR1C1 =  "=IF(COUNTIF(C1,RC1)>=3,RC[-3]*RC4,"""")"


da sich die Countif-Funktion für beide Spalten auf die Spalte 1 und die letze Multiplikation auf die Spalte 4 bezieht

Gruß, Daniel


  

Betrifft: AW: Code sorgt für 99%CPU Last und endet nicht?!? von: Lauren
Geschrieben am: 13.08.2008 13:19:25

Mahlzeit zusammen,



kann es sein, dass der Code von mir etwas zwischenspeichert und dann träge wird?!?!

Bei manchen Tabellenblättern huscht es ohne probleme in nullkommanix durch und bei anderen mit ca. 17000 Zeilen brauch er ne weile, verstehe ich ja soweit.



Aber dann kommt wieder ein Tabellenblatt mit nur 400 Zeilen und es braucht wieder eeeeeewig bis er die paar Rechnungen macht



Mein Code:





Sub Duplikatgruppierung()
'
' Duplikatgruppierung Makro
' Makro am 06.08.2008
'
'
' Löschen der Zeile wenn in Spalte D,E,F,G eine 0 steht

Dim i
For i = Cells(Rows.Count, 4).End(xlUp).Row To 1 Step -1
    On Error Resume Next
   If Cells(i, 4).Value = "0" Then
    Rows(i).Delete
  End If
  Next
For i = Cells(Rows.Count, 5).End(xlUp).Row To 1 Step -1
    On Error Resume Next
   If Cells(i, 5).Value = "0" Then
    Rows(i).Delete
  End If
  Next
For i = Cells(Rows.Count, 6).End(xlUp).Row To 1 Step -1
    On Error Resume Next
   If Cells(i, 6).Value = "0" Then
    Rows(i).Delete
  End If
  Next
For i = Cells(Rows.Count, 7).End(xlUp).Row To 1 Step -1
    On Error Resume Next
   If Cells(i, 7).Value = "0" Then
    Rows(i).Delete
  End If
  Next
For i = Cells(Rows.Count, 8).End(xlUp).Row To 1 Step -1
    On Error Resume Next
   If Cells(i, 8).Value = "0" Then
    Rows(i).Delete
  End If
  Next

' Prüfung auf >= 3 

Dim lngZeile As Long
   
    For lngZeile = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If Cells(lngZeile, 1).Value <> Cells(lngZeile - 1, 1).Value Then
           Rows(lngZeile & ":" & lngZeile + 2).Insert
        End If
    Next
Rows("2:4").Select
Selection.Delete Shift:=xlUp
Range("A2").Select

' Formatieriung
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "anual 1"
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "anual 2"
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "anual 3"
    Range("A1").Select
    ActiveCell.Offset(0, 12).Select
    ActiveCell.FormulaR1C1 = "Produkt 1"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "Produkt 2"
    
Range("A1").Select
End Sub

Sub Jahreswerte()
Dim LetzteZeile1 As Long, Zeile1 As Long, Suchbegriff As Long
LetzteZeile1 = Range("C65536").End(xlUp).Row
LetzteZeile1 = LetzteZeile1 + 1

' Produkte der Multiplikationen

Dim Zeilen As Long
Zeilen = Cells(Rows.Count, 1).End(xlUp).Row
Range("M2:M" & Zeilen).FormulaR1C1 = "=IF(COUNTIF(C[-12],RC[-12])>=3,RC[-3]*RC[-9],"""")"
Range("N2:N" & Zeilen).FormulaR1C1 = "=IF(COUNTIF(C[-13],RC[-13])>=3,RC[-3]*RC[-10],"""")"


' Bildung der Jahreswerte
' Summe wenn >= 3
 With Range("D2:D" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
      .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = _
      "=IF(R[-1]C1="""",TRUE,IF(COUNTIF(C1,R[-1]C1)<3,true,SUMIF(C1,R[-1]C1,C)))"
       .SpecialCells(xlCellTypeFormulas, 4).ClearContents
       .SpecialCells(xlCellTypeFormulas, 1).Offset(0, -1).Value = "SUMs"
  End With

' anual 1
Range("E2").Select
ActiveCell.FormulaR1C1 = "=IF(AND(R[-1]C[-4]<>RC[-4],RC[-4]="""",RC[-2]<>""""),RC[-1]/COUNTIF(C[ _
 _
-4],R[-1]C[-4])*12,"""")"
Selection.AutoFill Destination:=Range("E2:E" & LetzteZeile1), Type:=xlFillDefault

' Summe 1
With Range("F2:F" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = _
    "=IF(R[-1]C1="""",TRUE,IF(COUNTIF(C1,R[-1]C1)<3,true,SUMIF(C1,R[-1]C1,C)))"
      .SpecialCells(xlCellTypeFormulas, 4).ClearContents
End With

' anual 2
Range("G2").Select
ActiveCell.FormulaR1C1 = "=IF(AND(R[-1]C[-6]<>RC[-6],RC[-6]="""",RC[-4]<>""""),RC[-1]/COUNTIF(  _
_
C1,R[-1]C[-6])*12,"""")"
Selection.AutoFill Destination:=Range("G2:G" & LetzteZeile1), Type:=xlFillDefault

' Summe 2
With Range("H2:H" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = _
    "=IF(R[-1]C1="""",TRUE,IF(COUNTIF(C1,R[-1]C1)<3,true,SUMIF(C1,R[-1]C1,C)))"
      .SpecialCells(xlCellTypeFormulas, 4).ClearContents
End With

' anual 3
Range("I2").Select
ActiveCell.FormulaR1C1 = "=IF(AND(R[-1]C[-8]<>RC[-8],RC[-8]="""",RC[-6]<>""""),RC[-1]/COUNTIF(  _
_
C1,R[-1]C[-8])*12,"""")"
Selection.AutoFill Destination:=Range("I2:I" & LetzteZeile1), Type:=xlFillDefault

'Next ws
Range("A1").Select
End Sub

Sub auswertung()

Dim LetzteZeile As Long, Zeile1 As Long, Suchbegriff As Long
LetzteZeile = Range("A65536").End(xlUp).Row
LetzteZeile = LetzteZeile + 4
Range("A" & LetzteZeile).Select

ActiveCell.Offset(0, 4).Select
ActiveCell.Value = "abcd"
ActiveCell.Offset(0, 2).Select
ActiveCell.Value = "efgh"
ActiveCell.Offset(0, 2).Select
ActiveCell.Value = "ijklm"

With ActiveCell
      Range(.Offset(0, 0), .Offset(0, -7)).Select
   End With

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Bold = True
    
Range("A" & LetzteZeile).Select

ActiveCell.Offset(1, 3).Select
ActiveCell.Value = "SUM: "
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "AVG: "
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "MIN: "
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "MAX: "
Selection.Font.Bold = True

LetzteZeile = LetzteZeile - 3
ActiveCell.Offset(-3, 1).Select
ActiveCell.Formula = "=sum(E2:E" & LetzteZeile & ")/1000"
ActiveCell.Offset(0, 2).Select
ActiveCell.Formula = "=sum(G2:G" & LetzteZeile & ")/1000"
ActiveCell.Offset(0, 2).Select
ActiveCell.Formula = "=sum(I2:I" & LetzteZeile & ")/1000"

Columns("E:N").EntireColumn.AutoFit
End Sub





ich führe die schritte bzw. makros jetzt einzeln aus und mal geht es schnell und wenn es einmalewig gedauert hat, dauert es bei den darauffolgenden Berechnungen auch immer eeeeewig.



Jemand ne Idee woren es liegen könnte?


  

Betrifft: AW: Code sorgt für 99%CPU Last und endet nicht?!? von: Lauren
Geschrieben am: 13.08.2008 16:26:36

Hallo,

also an meinem Code liegts nicht vermute ich
wenn es ein Tabellenblatt mit ca. 20.000 Zeilen sind, kommt es mit den Berechnungen n och gut zu recht aber ab 20.000 Zeilen wird es eben seeeeeeeeeeeeeeeeeeeeeehr Träge

Ausgestattet mit

(AMD ATHLON 3800+) 2.4 GHz und NUR 1GB RAM dauert es wohl eben etwas längert :)

Habe jetzt dann die Rechnungen nach der Größe bzw. nach den verwendeten Zeilenmengen priorisiert und jetzt geht das ganze eben seinen lauf. Noch 2 Tabellenblätter mit mehr als 20.000 Zeilen sind noch offen, dann lass ich eine abschlusssrechnung über die gesamten Tabellenblätter laufen und gut ist


  

Betrifft: AW: Code sorgt für 99%CPU Last und endet nicht?!? von: Daniel
Geschrieben am: 13.08.2008 19:22:11

Hallo

ich schätze mal, das Hauptproblem ist dein erstes Makro zum löschen und einfügen von Zeilen.
das ist seeeehr zeitaufwendig, wenn man jede Zeile einzeln löschen will.
viel effektiver ist es, alle Zeilen, die gelöscht werden sollen, per Formel zu markieren und dann um zu sortieren, so daß alle zu löschenden Zeilen einen Zusammenhängenden Zellblock bilden.
diesen kann man dann auf einmal löschen und ist somit wesentlich schneller, weil Excel nur einen Löschvorgang bearbeiten muss und nicht viele.

gleiches beim Einfügen von Zeilen, das ist auch seeehr langsam.
das Makro zeigt einen Trick, wie die Leerzeilen über Umsortieren in die Datei kommen.
das Sortieren geht in Excel auch sehr schnell.

mit diesem Makro sollte sich auch eine 20.000-Zeilen-datei mit vielen Löschungen und Einfügungen in wenigen Sekunden bearbeiten lassen.
und keine Angst, durch das Umsortiern wird die Reihenfolge der nichtbetroffenen Zeilen nicht verändert.

setze dieses Makro mal für Duplikat-Gruppierung ein und staune:

Sub löschen()
   Dim sp As Long
   Dim ze As Long
   Dim i As Long
   sp = Cells(1, Columns.Count).End(xlToLeft).Column + 1
   ze = Cells(Rows.Count, 1).End(xlUp).Row
   
   '--- Zeilen mit 0 in Spalte D,E,F,G löschen
   With Range(Cells(1, sp), Cells(ze, sp))
      .FormulaR1C1 = "=IF(COUNTIF(RC4:RC7,0)>0,"""",ROW())"
      .Formula = .Value
      .EntireRow.Sort key1:=Cells(1, sp), order1:=xlAscending, header:=xlNo
      On Error Resume Next
      .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      On Error GoTo 0
      .EntireColumn.Delete
   End With
   
   '--- Zeilen einfügen, wenn neue gruppe
   ze = Cells(Rows.Count, 1).End(xlUp).Row
   With Range(Cells(1, sp), Cells(ze, sp))
      .Formula = "=Row()"
      .Formula = .Value
   End With
   Application.ScreenUpdating = False
   For i = 2 To ze - 1
      If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
      Cells(Rows.Count, sp).End(xlUp).Offset(1, 0).Resize(2).Value = i
   End If
Next
Application.ScreenUpdating = True
With Range(Cells(1, sp), Cells(Rows.Count, sp).End(xlUp))
   .EntireRow.Sort key1:=Cells(1, sp), order1:=xlAscending, header:=xlNo
   .EntireColumn.Delete
End With

End Sub




Gruß, Daniel

btw, zumindes die Methode zum Löschen von Daten könntest du auch ohne Makro anwenden (Formel einfügen, sortieren - filtern - löschen) und wärest damit wahrscheinlich sogar schneller als dein jetziges Makro.


  

Betrifft: AW: Code sorgt für 99%CPU Last und endet nicht?!? von: Daniel
Geschrieben am: 13.08.2008 16:45:17

Hi

Grundsätzliches Problem ist dein Programmierstil, der viel Zeit verschwendet:

Range("A" & LetzteZeile).Select

ActiveCell.Offset(1, 3).Select
ActiveCell.Value = "SUM: "
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "AVG: "
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "MIN: "
Selection.Font.Bold = True
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "MAX: "
Selection.Font.Bold = True



müsste grundsätzlich so umgeschrieben werden:

cells(LetzteZeile, 4).value = "SUM: "
cells(LetzteZeile, 5).value = "AVG: "
cells(LetzteZeile, 6).value = "MIN: "
cells(LetzteZeile, 7).value = "MAX: "
Range(Cells(letzteZeile,4), Cells(letzteZeile,4)).font.Bold = True



dh jedes SELECT, ACTIVECELL und SELECTION muss aus dem Code entfernt werden und die Zellen müssen immer direkt referenziert werden.
also nie:

Range("A1").Select
Selection.Value = "Hallo"


sondern immer

Range("A1").value = "Hallo"



außerdem sollten Aktionen, die für mehrere Zellen gleich sind, auch für diese Zellen aufeinmal durchführen und nicht für jede Zelle einzeln (wie für .Font.Bold = TRUE aus dem obigen Beispiel)

versuche mal, das in deinem Code konsequent umzusetzen, dann kann man nochmal drüberschauen, wo die Bremsen sitzen. vorher macht es keinen Sinn.

Gruß, Daniel


  

Betrifft: AW: Code sorgt für 99%CPU Last und endet nicht?!? von: Lauren
Geschrieben am: 14.08.2008 13:45:33

Hallo Daniel,

vielen Dank für deine Hilfe!
Werde es mal austesten mit den Verbesserungsvorschlägen.

Mit dem Einfügen von Leerzeilen hatte ich bis dato kein Problem, das Problem sind eher die Summenbildungen und anschließend die Bildung der Produkte der Multiplikationen 1 und 2.

Das Durchsuchen und Einfügen von Leerzeilen hat wunderbar funktioniert gehabt.

Das Problem ist jetzt, dass nach den Berechnungen alles eeeeeeeeewig dauert. Wenn ich unter eine Spalte manuel ein SUM bilde dann braucht Excel eeeeeeeeeeewig. Es erstellt in der Taskleiste eine Art Auslagerungsdatei und wenn der Vorgang abgeschlossen ist verschwindet es wieder und es gibt nur das aktive Excel file.

WORAN LIEGT DAS???

Ist die Datei mit 22MB zu groß?!?!

Viele Grüße


  

Betrifft: AW: Code sorgt für 99%CPU Last und endet nicht?!? von: Lauren
Geschrieben am: 14.08.2008 13:47:00

Ich habe gerade nochmal nachgesehen, nach den Berechnungen ist das Excelfile jetzt 42MB groß!?!?


  

Betrifft: AW: Code sorgt für 99%CPU Last und endet nicht?!? von: Daniel
Geschrieben am: 14.08.2008 14:48:55

Hi

je nun, ich wusste ja nicht, wie gross deine Daten sind.
bei jeder SummeWenn-Formel wird eben die komplette Zeile durchsucht, das dauert dann halt.
die SummeWenn-Funktioni habe ich damals gewählt, um alle Auswertungen mit der gleichen Formel zu machen.

für die Berechnung wäre es natürlich besser, für jede Zeilen eine individuelle Formel zu bilden, die sich dann nur auf den tatsächlich notwendigen Zellbereich bezieht, das wäre für die Berechnung schneller, würde aber ein aufwendigeres Makro erfordern, da wie gesagt dann jede Formel erst individuell erstellt werden muss.

aber generell rate ich bei diesen Datenmengen davon ab, Daten und Auswertung in einer Liste zu mischen und würde empfehlen, die Auswertung über eine Pivot-Tabelle zu lösen, das geht schnell mit wenigen Mausklicks und ist auch von der Rechenzeit her sehr schnell.

Gruß, Daniel