Microsoft Excel

Herbers Excel/VBA-Archiv

Makro zu langsam | Herbers Excel-Forum


Betrifft: Makro zu langsam von: mehmet
Geschrieben am: 01.02.2012 10:13:29

Guten Tag Forum,
ich habe mittels Macrorecorder folgenden Macro aufnehmen und anpassen können:

Private Sub Text_in_Zahl_und_BedFormat_Spalte_AV_bzw_Z_TempTau_an()
'AV11=WECHSELN(LINKS(Z11;FINDEN("/";Z11)-1);"M";"-";1)-WECHSELN(TEIL(Z11;VERWEIS(9^9;FINDEN("/"; _
Z11;ZEILE(Z:Z)))+1;99);"M";"-";1)
    Range("AV11").Select
    Selection.NumberFormat = "General"
    ActiveCell.FormulaR1C1 = _
        "=SUBSTITUTE(LEFT(RC[-22],FIND(""/"",RC[-22])-1),""M"",""-"",1)-SUBSTITUTE(MID(RC[-22], _
LOOKUP(9^9,FIND(""/"",RC[-22],ROW(C[-22])))+1,99),""M"",""-"",1)"
    Range("AV11").Select
    Selection.AutoFill Destination:=Range("AV11:AV58"), Type:=xlFillDefault
    Range("AV11:AV58").Select
    Range("AV11").Select
'Jetzt von Hilfs Zelle AV nach Z übertragen
'Mache die erste Bed Format
    Range("Z11").Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AV11<=1"
    Selection.FormatConditions(1).Interior.ColorIndex = 3
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AV11<=3"
    Selection.FormatConditions(2).Interior.ColorIndex = 45
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AV11<=5"
    Selection.FormatConditions(3).Interior.ColorIndex = 6
'Bed Format Z11:Z58 von oben nach unten
    Selection.Copy:     Range("Z12").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z13").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z14").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z15").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z16").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z17").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z18").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z19").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z20").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z21").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z22").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z23").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z24").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z25").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z26").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z27").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z28").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z29").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z30").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z31").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z32").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z33").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z34").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z35").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z36").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z37").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z38").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z39").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z40").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z41").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z42").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z43").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z44").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z45").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z46").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z47").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z48").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z49").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z50").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z51").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z52").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z53").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z54").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z55").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z56").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z57").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy:    Range("Z58").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False,  _
Transpose:=False
    Application.CutCopyMode = False
    Range("Z11").Select
End Sub
Leider ist der Macro sehr rechenintensiv
Könnt ihr euch vorstellen voran das liegen kann oder eine Korrektur/Vorschlag machen
Herzlichen Dank
Gruss
mehmet

  

Betrifft: AW: Makro zu langsam von: Reinhard
Geschrieben am: 01.02.2012 10:37:30

Hallo Mehmet,
macht dies das Gleiche?

Private Sub Text_in_Zahl_und_BedFormat_Spalte_AV_bzw_Z_TempTau_an()
With Range("AV11")
  .NumberFormat = "General"
  .FormulaR1C1 = _
        "=SUBSTITUTE(LEFT(RC[-22],FIND(""/"",RC[-22])-1),""M"",""-"",1)-SUBSTITUTE(MID(RC[-22]," _
 _
            & "LOOKUP(9^9,FIND(""/"",RC[-22],ROW(C[-22])))+1,99),""M"",""-"",1)"
  .AutoFill Destination:=Range("AV11:AV58"), Type:=xlFillDefault
End With
'Jetzt von Hilfs Zelle AV nach Z übertragen
'Mache die erste Bed Format
With Range("Z11")
  .FormatConditions.Delete
  .FormatConditions.Add Type:=xlExpression, Formula1:="=AV11<=1"
  .FormatConditions(1).Interior.ColorIndex = 3
  .FormatConditions.Add Type:=xlExpression, Formula1:="=AV11<=3"
  .FormatConditions(2).Interior.ColorIndex = 45
  .FormatConditions.Add Type:=xlExpression, Formula1:="=AV11<=5"
  .FormatConditions(3).Interior.ColorIndex = 6
  'Bed Format Z11:Z58 von oben nach unten
  .Copy
End With
Range("Z12:Z58").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
  SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

Gruß
Reinhard


  

Betrifft: AW: Makro zu langsam von: mehmet
Geschrieben am: 01.02.2012 10:46:02

Hallo Reinhard,
ja macht es 8-)
und ist dabei sehr schnell
Herzlichen Dank
Gruss
mehmet


  

Betrifft: @Reinhard: Vorsicht! von: Rudi Maintaire
Geschrieben am: 01.02.2012 10:58:57

Hallo,
wenn beim Einfügen der FormatConditions eine andere Zelle als Z11 aktiv ist, geht das schief. Deshalb ausnahmsweise mal Z11.Select.

Gruß
Rudi


  

Betrifft: AW: @Reinhard: Vorsicht! von: Reinhard
Geschrieben am: 01.02.2012 11:04:22

Hallo Rudi,

weia, wie soll man denn da draufkommen :-(
Sicher, ich habe nicht getestet, aber sowas kann auch leicht beim Testen durchflutschen *glaub*

Danke dir Rudi.
Gruß
Reinhard


  

Betrifft: DANKE ... ich war schon am Verzweifeln! von: Matthias L
Geschrieben am: 01.02.2012 11:13:14

Hallo Rudi

Danke für die Info.

Ich hatte immer und immer wieder getestet und alle Zellen wurden bei mir jedesmal Rot
Ich hatte auch Select rausgenommen.
Naja, wie man immer so schön liest
Man kann zu 99,9 Prozent auf Select verzichten - aber eben nicht zu 100 Prozent.

Gruß Matthias


  

Betrifft: Bitte von: Rudi Maintaire
Geschrieben am: 01.02.2012 11:24:19

Hallo,
wenn die zu formatierende Zelle nicht auf dem aktiven Blatt liegt, kann man sie auch erst mal kopieren und die Formate einfügen. Dann wird sie aktiv. Geht also auch ohne Select.

With Tabelle1.Range("Z11:Z58")
  .Copy
  .PasteSpecial xlPasteFormats
  .FormatConditions.Delete
  ......
  .....
End With
Gruß
Rudi


  

Betrifft: AW: Makro zu langsam von: Rudi Maintaire
Geschrieben am: 01.02.2012 10:42:59

Hallo,
das sollte eigentlich reichen:

Private Sub Text_in_Zahl_und_BedFormat_Spalte_AV_bzw_Z_TempTau_an()
  'AV11=WECHSELN(LINKS(Z11;FINDEN("/";Z11)-1);"M";"-";1)-WECHSELN(TEIL(Z11;VERWEIS(9^9;FINDEN("/ _
"; _
    Z11;ZEILE(Z:Z)))+1;99);"M";"-";1)
  Application.ScreenUpdating = False
  With Range("AV11")
    .NumberFormat = "General"
    .FormulaR1C1 = "=SUBSTITUTE(LEFT(RC[-22],FIND(""/"",RC[-22])-1),""M"",""-"",1)" _
      & "-SUBSTITUTE(MID(RC[-22], LOOKUP(9^9,FIND(""/"",RC[-22],ROW(C[-22])))+1,99),""M"",""-"", _
1)"
    .AutoFill Destination:=Range("AV11:AV58"), Type:=xlFillDefault
  End With
  'Jetzt von Hilfs Zelle AV nach Z übertragen
  'Mache die erste Bed Format
  Range("Z11").Select
  With Range("Z11")
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlExpression, Formula1:="=AV11<=1"
    .FormatConditions(1).Interior.ColorIndex = 3
    .FormatConditions.Add Type:=xlExpression, Formula1:="=AV11<=3"
    .FormatConditions(2).Interior.ColorIndex = 45
    .FormatConditions.Add Type:=xlExpression, Formula1:="=AV11<=5"
    .FormatConditions(3).Interior.ColorIndex = 6
    'Bed Format Z11:Z58 von oben nach unten
    .Copy
  End With
  Range("Z12:Z58").PasteSpecial _
    Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
End Sub

Gruß
Rudi


  

Betrifft: AW: Makro zu langsam von: mehmet
Geschrieben am: 01.02.2012 10:49:15

Hallo Rudi,
Dank dir
macht auch was es soll und ist schnell dabei
Ihr seid echt super
Gruss
mehmet


Beiträge aus den Excel-Beispielen zum Thema "Makro zu langsam"