Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Frame
BildScreenshot zu Frame Frame-Seite mit Beispielarbeitsmappe aufrufen

excel-makro in vba code umwandeln | Herbers Excel-Forum


Betrifft: excel-makro in vba code umwandeln von: mirko
Geschrieben am: 18.12.2009 22:40:11

Hallo und guten Abend,
ich habe eine umfangreiche Exceltabelle geschrieben und würde mir dazu gerne Expertenrat einholen.

Zunächst würde ich mich freuen, wenn jemand Lust und Zeit hat, mir Tipps zu gebeben, wie die vielen Makros, die ich aufgezeichnet habe mit Hilfe von VBA verkürzt werden könnten.

Die Berechnungen benötigen zum Teil wegen Zirkelverweise die Interationfunktion, - läuft die unter Excel 2007 besser?

Also bei meiner Tabelle unter Excel 2003 ist die Interation gerademal ausreichend, was die Berechnungszeit und die genauigkeit des Ergebnis angeht.

Im Folgenden poste ich mal das Makro, welches drei Minuten zur Berechnung braucht, die Interation auf zehn Zahlen und Genauigkeit auf eins eingestellt.

Sub Berechnung_MFH()
'
' Berechnung_MFH Makro
' Makro am 01.12.2009 von Mirko Eichler aufgezeichnet
'

'
    Dim objSpeaker As Object
    Dim intIndex As Integer
    Set objSpeaker = CreateObject("SAPI.SpVoice")
    Set objSpeaker.Voice = objSpeaker.GetVoices( _
    "Name=ScanSoft Steffi_Dri40_16kHz").Item(0)
    objSpeaker.Volume = 100
    objSpeaker.Speak "B H K W Berechnung gestartet"
Sheets("Bemessung").Select
    ActiveSheet.Scenarios("100").Delete
    ActiveSheet.Scenarios("99").Delete
    ActiveSheet.Scenarios("98").Delete
    ActiveSheet.Scenarios("97").Delete
    ActiveSheet.Scenarios("96").Delete
    ActiveSheet.Scenarios("95").Delete
    ActiveSheet.Scenarios("94").Delete
    ActiveSheet.Scenarios("93").Delete
    ActiveSheet.Scenarios("92").Delete
    ActiveSheet.Scenarios("91").Delete
    ActiveSheet.Scenarios("90").Delete
    ActiveSheet.Scenarios("89").Delete
    ActiveSheet.Scenarios("88").Delete
    ActiveSheet.Scenarios("87").Delete
    ActiveSheet.Scenarios("86").Delete
    ActiveSheet.Scenarios("85").Delete
    ActiveSheet.Scenarios("84").Delete
    ActiveSheet.Scenarios("83").Delete
    ActiveSheet.Scenarios("82").Delete
    ActiveSheet.Scenarios("81").Delete
    ActiveSheet.Scenarios("80").Delete
    ActiveSheet.Scenarios("79").Delete
    ActiveSheet.Scenarios("78").Delete
    ActiveSheet.Scenarios("77").Delete
    ActiveSheet.Scenarios("76").Delete
    ActiveSheet.Scenarios("75").Delete
    ActiveSheet.Scenarios("74").Delete
    ActiveSheet.Scenarios("73").Delete
    ActiveSheet.Scenarios("72").Delete
    ActiveSheet.Scenarios("71").Delete
    ActiveSheet.Scenarios("70").Delete
    ActiveSheet.Scenarios("69").Delete
    ActiveSheet.Scenarios("68").Delete
    ActiveSheet.Scenarios("67").Delete
    ActiveSheet.Scenarios("66").Delete
    ActiveSheet.Scenarios("65").Delete
    ActiveSheet.Scenarios("64").Delete
    ActiveSheet.Scenarios("63").Delete
    ActiveSheet.Scenarios("62").Delete
    ActiveSheet.Scenarios("61").Delete
    ActiveSheet.Scenarios("60").Delete
    ActiveSheet.Scenarios("59").Delete
    ActiveSheet.Scenarios("58").Delete
    ActiveSheet.Scenarios("57").Delete
    ActiveSheet.Scenarios("56").Delete
    ActiveSheet.Scenarios("55").Delete
    ActiveSheet.Scenarios("54").Delete
    ActiveSheet.Scenarios("53").Delete
    ActiveSheet.Scenarios("52").Delete
    ActiveSheet.Scenarios("51").Delete
    ActiveSheet.Scenarios("50").Delete
    ActiveSheet.Scenarios("49").Delete
    ActiveSheet.Scenarios("48").Delete
    ActiveSheet.Scenarios("47").Delete
    ActiveSheet.Scenarios("46").Delete
    ActiveSheet.Scenarios("45").Delete
    ActiveSheet.Scenarios("44").Delete
    ActiveSheet.Scenarios("43").Delete
    ActiveSheet.Scenarios("42").Delete
    ActiveSheet.Scenarios("41").Delete
    ActiveSheet.Scenarios("40").Delete
    ActiveSheet.Scenarios("39").Delete
    ActiveSheet.Scenarios("38").Delete
    ActiveSheet.Scenarios("37").Delete
    ActiveSheet.Scenarios("36").Delete
    ActiveSheet.Scenarios("35").Delete
    ActiveSheet.Scenarios("34").Delete
    ActiveSheet.Scenarios("33").Delete
    ActiveSheet.Scenarios("32").Delete
    ActiveSheet.Scenarios("31").Delete
    ActiveSheet.Scenarios("30").Delete
    ActiveSheet.Scenarios("29").Delete
    ActiveSheet.Scenarios("28").Delete
    ActiveSheet.Scenarios("27").Delete
    ActiveSheet.Scenarios("26").Delete
    ActiveSheet.Scenarios("25").Delete
    ActiveSheet.Scenarios("24").Delete
    ActiveSheet.Scenarios("23").Delete
    ActiveSheet.Scenarios("22").Delete
    ActiveSheet.Scenarios("21").Delete
    ActiveSheet.Scenarios("20").Delete
    ActiveSheet.Scenarios("19").Delete
    ActiveSheet.Scenarios("18").Delete
    ActiveSheet.Scenarios("17").Delete
    ActiveSheet.Scenarios("16").Delete
    ActiveSheet.Scenarios("15").Delete
    ActiveSheet.Scenarios("14").Delete
    ActiveSheet.Scenarios("13").Delete
    ActiveSheet.Scenarios("12").Delete
    ActiveSheet.Scenarios("11").Delete
    ActiveSheet.Scenarios("10").Delete
    ActiveSheet.Scenarios("9").Delete
    ActiveSheet.Scenarios("8").Delete
    ActiveSheet.Scenarios("7").Delete
    ActiveSheet.Scenarios("6").Delete
    ActiveSheet.Scenarios("5").Delete
    ActiveSheet.Scenarios("4").Delete
    ActiveSheet.Scenarios("3").Delete
    ActiveSheet.Scenarios("2").Delete
    ActiveSheet.Scenarios("1").Delete
    
    ActiveSheet.Scenarios.Add Name:="1", ChangingCells:="R24C6", Values:= _
        Range("D31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="2", ChangingCells:="R24C6", Values:= _
        Range("E31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="3", ChangingCells:="R24C6", Values:= _
        Range("F31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="4", ChangingCells:="R24C6", Values:= _
        Range("G31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="5", ChangingCells:="R24C6", Values:= _
        Range("H31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="6", ChangingCells:="R24C6", Values:= _
        Range("I31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="7", ChangingCells:="R24C6", Values:= _
        Range("J31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="8", ChangingCells:="R24C6", Values:= _
        Range("K31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="9", ChangingCells:="R24C6", Values:= _
        Range("L31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="10", ChangingCells:="R24C6", Values:= _
        Range("M31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="11", ChangingCells:="R24C6", Values:= _
        Range("N31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="12", ChangingCells:="R24C6", Values:= _
        Range("O31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="13", ChangingCells:="R24C6", Values:= _
        Range("P31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="14", ChangingCells:="R24C6", Values:= _
        Range("Q31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="15", ChangingCells:="R24C6", Values:= _
        Range("R31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="16", ChangingCells:="R24C6", Values:= _
        Range("S31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="17", ChangingCells:="R24C6", Values:= _
        Range("T31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="18", ChangingCells:="R24C6", Values:= _
        Range("U31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="19", ChangingCells:="R24C6", Values:= _
        Range("V31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="20", ChangingCells:="R24C6", Values:= _
        Range("W31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="21", ChangingCells:="R24C6", Values:= _
        Range("X31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="22", ChangingCells:="R24C6", Values:= _
        Range("Y31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="23", ChangingCells:="R24C6", Values:= _
        Range("Z31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="24", ChangingCells:="R24C6", Values:= _
        Range("AA31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="25", ChangingCells:="R24C6", Values:= _
        Range("AB31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="26", ChangingCells:="R24C6", Values:= _
        Range("AC31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="27", ChangingCells:="R24C6", Values:= _
        Range("AD31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="28", ChangingCells:="R24C6", Values:= _
        Range("AE31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="29", ChangingCells:="R24C6", Values:= _
        Range("AF31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="30", ChangingCells:="R24C6", Values:= _
        Range("AG31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="31", ChangingCells:="R24C6", Values:= _
        Range("AH31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="32", ChangingCells:="R24C6", Values:= _
        Range("AI31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="33", ChangingCells:="R24C6", Values:= _
        Range("AJ31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="34", ChangingCells:="R24C6", Values:= _
        Range("AK31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="35", ChangingCells:="R24C6", Values:= _
        Range("AL31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="36", ChangingCells:="R24C6", Values:= _
        Range("AM31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="37", ChangingCells:="R24C6", Values:= _
        Range("AN31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="38", ChangingCells:="R24C6", Values:= _
        Range("AO31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="39", ChangingCells:="R24C6", Values:= _
        Range("AP31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="40", ChangingCells:="R24C6", Values:= _
        Range("AQ31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="41", ChangingCells:="R24C6", Values:= _
        Range("AR31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="42", ChangingCells:="R24C6", Values:= _
        Range("AS31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="43", ChangingCells:="R24C6", Values:= _
        Range("AT31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="44", ChangingCells:="R24C6", Values:= _
        Range("AU31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="45", ChangingCells:="R24C6", Values:= _
        Range("AV31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="46", ChangingCells:="R24C6", Values:= _
        Range("AW31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="47", ChangingCells:="R24C6", Values:= _
        Range("AX31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="48", ChangingCells:="R24C6", Values:= _
        Range("AY31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="49", ChangingCells:="R24C6", Values:= _
        Range("AZ31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="50", ChangingCells:="R24C6", Values:= _
        Range("BA31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="51", ChangingCells:="R24C6", Values:= _
        Range("BB31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="52", ChangingCells:="R24C6", Values:= _
        Range("BC31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="53", ChangingCells:="R24C6", Values:= _
        Range("BD31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="54", ChangingCells:="R24C6", Values:= _
        Range("BE31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="55", ChangingCells:="R24C6", Values:= _
        Range("BF31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="56", ChangingCells:="R24C6", Values:= _
        Range("BG31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="57", ChangingCells:="R24C6", Values:= _
        Range("BH31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="58", ChangingCells:="R24C6", Values:= _
        Range("BI31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="59", ChangingCells:="R24C6", Values:= _
        Range("BJ31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="60", ChangingCells:="R24C6", Values:= _
        Range("BK31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="61", ChangingCells:="R24C6", Values:= _
        Range("BL31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="62", ChangingCells:="R24C6", Values:= _
        Range("BM31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="63", ChangingCells:="R24C6", Values:= _
        Range("BN31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="64", ChangingCells:="R24C6", Values:= _
        Range("BO31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="65", ChangingCells:="R24C6", Values:= _
        Range("BP31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="66", ChangingCells:="R24C6", Values:= _
        Range("BQ31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="67", ChangingCells:="R24C6", Values:= _
        Range("BR31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="68", ChangingCells:="R24C6", Values:= _
        Range("BS31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="69", ChangingCells:="R24C6", Values:= _
        Range("BT31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="70", ChangingCells:="R24C6", Values:= _
        Range("BU31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="71", ChangingCells:="R24C6", Values:= _
        Range("BV31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="72", ChangingCells:="R24C6", Values:= _
        Range("BW31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="73", ChangingCells:="R24C6", Values:= _
        Range("BX31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="74", ChangingCells:="R24C6", Values:= _
        Range("BY31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="75", ChangingCells:="R24C6", Values:= _
        Range("BZ31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="76", ChangingCells:="R24C6", Values:= _
        Range("CA31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="77", ChangingCells:="R24C6", Values:= _
        Range("CB31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="78", ChangingCells:="R24C6", Values:= _
        Range("CC31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="79", ChangingCells:="R24C6", Values:= _
        Range("CD31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="80", ChangingCells:="R24C6", Values:= _
        Range("CE31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="81", ChangingCells:="R24C6", Values:= _
        Range("CF31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="82", ChangingCells:="R24C6", Values:= _
        Range("CG31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="83", ChangingCells:="R24C6", Values:= _
        Range("CH31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="84", ChangingCells:="R24C6", Values:= _
        Range("CI31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="85", ChangingCells:="R24C6", Values:= _
        Range("CJ31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="86", ChangingCells:="R24C6", Values:= _
        Range("CK31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="87", ChangingCells:="R24C6", Values:= _
        Range("CL31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="88", ChangingCells:="R24C6", Values:= _
        Range("CM31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="89", ChangingCells:="R24C6", Values:= _
        Range("CN31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="90", ChangingCells:="R24C6", Values:= _
        Range("CO31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="91", ChangingCells:="R24C6", Values:= _
        Range("CP31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="92", ChangingCells:="R24C6", Values:= _
        Range("CQ31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="93", ChangingCells:="R24C6", Values:= _
        Range("CR31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="94", ChangingCells:="R24C6", Values:= _
        Range("CS31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="95", ChangingCells:="R24C6", Values:= _
        Range("CT31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="96", ChangingCells:="R24C6", Values:= _
        Range("CU31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="97", ChangingCells:="R24C6", Values:= _
        Range("CV31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="98", ChangingCells:="R24C6", Values:= _
        Range("CW31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="99", ChangingCells:="R24C6", Values:= _
        Range("CX31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.Add Name:="100", ChangingCells:="R24C6", Values:= _
        Range("CY31"), Comment:="Erstellt von Mirko Eichler am 15.11.2009", Locked:= _
        True, Hidden:=False
    ActiveSheet.Scenarios.CreateSummary ReportType:=xlStandardSummary, _
        ResultCells:=Range("J12:J17")
    Range("E8:CZ13").Select
    Selection.Copy
    Sheets("Bemessung").Select
    Range("D63").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Szenariobericht").Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    Sheets("Bemessung").Select
    Range("F24").Select
    ActiveCell.FormulaR1C1 = "=RC[-4]"
    Range("F25").Select
    Sheets("Ergebnis").Select
    Range("E3").Select
    objSpeaker.Speak "B H K W Berechnung abgeschlossen"
        Set objSpeaker = Nothing
End Sub

Das Makro startet eine Prozedur mit 100 Szenario (1-100%), in dessen Folge die Interation steht. Der Speaker muss nicht erhalten bleiben, ich wollte eigentlich, das mir der Berechnungsfortschrit währen der Interation angesagt wird, doch wenn ich an den entsprechenden Stellen .Speak = "xx Prozent" eintrage, liest Steffi das alles vor der Berechnung vor und dann dauer das immer noch drei Minuten, gibt es für die Vortschrittanzeige eine andere Möglichkeit? Habe da an visualisierung gedacht, wenn aural nicht geht.

Schon mal vielen dank für jede Antwort.

Gruß Mirko

  

Betrifft: AW: excel-makro in vba code umwandeln von: Josef Ehrensberger
Geschrieben am: 18.12.2009 23:06:30

Hallo Mirko,

ein Makro ist VBA-Code, egal ob aufgezeichnet oder selbst geschrieben!

Ungetestet.

Sub Berechnung_MFH()
  Dim lngCount As Long
  
  With Sheets("Bemessung")
    
    For lngCount = 1 To 100
      Application.StatusBar = "Lösche Szenario " & CStr(lngCount) & " von 100"
      .Scenarios(CStr(lngCount)).Delete
    Next
    
    For lngCount = 1 To 100
      Application.StatusBar = "Berechne Szenario " & CStr(lngCount) & " von 100"
      .Scenarios.Add Name:=CStr(lngCount), _
        ChangingCells:=.Range("F24"), _
        Values:=.Cells(31, lngCount + 3), _
        Comment:="Erstellt von " & Environ("USERNAME") & _
        " am " & Format(Date, "dd.MM.yyyy"), _
        Locked:=True, Hidden:=False
    Next
    
    .Scenarios.CreateSummary ReportType:=xlStandardSummary, _
      ResultCells:=.Range("J12:J17")
    
    .Range("E8:CZ13").copy .Range("D63")
    .Range("F24").FormulaR1C1 = "=RC[-4]"
    
  End With
  
  Application.StatusBar = False
End Sub



Gruß Sepp



  

Betrifft: AW: excel-makro in vba code umwandeln von: mirko
Geschrieben am: 18.12.2009 23:45:11

Hallo Sepp,
danke für den Code, augenscheinlich funktioniert dieser. Ich bin total überrascht. Der Rechner (Notebook) hat kein bisschen geföhnt, ich dachte schon das Excel wäre abgestürzt. Da hat sich erstmal nichts getan, doch nach etwa einer Minute kam der Szenariobericht.
Das ist der Hammer, ich habe an dieser Tabelle drei Monate gearbeitet und der Ausgangscode, hat sehr lange gerechnet, etwa drei Minuten und der Rechner ist immer auf Volllast gefahren und hat den CPU heiß gekocht. Echt super dieser Fortschritt, vielen Dank.

Ich bin gespannt, wenn ich den Code anpasse was damit noch alles möglich ist, zunächst würde ich wieder die voice integrieren, um den Bearbeitungsstand ansagen zu lassen.
Auch eine visuelle Methode wäre gut.

Weiter hätte ich gerne, dass die Berechnung auf einem anderen Sheet ausgeführt wird, aber die Ansicht auf dem aktuellen Tabellenblatt bleibt? Mich stört das Umschalten, da die Tabellen, auf denen gerechnet wird optisch nicht toll sind und nur die Ein- und Ausgabetabellen, sowie Diagramme eingesehen werden sollten. Schön wäre es, wenn man die Seiten ausblenden könnte, obwohl ein Makro darauf abläuft.

Gruß Mirko


  

Betrifft: AW: excel-makro in vba code umwandeln von: Josef Ehrensberger
Geschrieben am: 19.12.2009 08:21:27

Hallo Mirko,

schau mal auf die Statusleiste, da siehst du den Fortschritt.


Gruß Sepp



  

Betrifft: AW: excel-makro in vba code umwandeln von: Mirko
Geschrieben am: 19.12.2009 08:47:56

Hallo Sepp,
wenn die Statusleiste am unteren Rand den Fortschritt, links anzeigen soll, dann Funktioniert diese nicht . Da steht durchgehend Szenario 100 von 100, daher dachte ich auch beim ersten Durchlauf der Rechner sei abgestürzt.

Lässt sich mit dem Richtigen knowhow sicherlich beheben, was schon ein guter Fortschritt wäre, wenn die Anzeige mitlaufen würde. Im besten Fall gibt es etwas, dass als zusätliches Window eingeblendet wird und den Berechnungsstand anzeigt.

Wie ist denn das mit der Interationfunktion unter Excel 2007, gibt es da gegenüber 2003 deutliche Fortschritte, was die Geschwindigkeit und Genauigkeit der Berechnung angeht?

Gruß Mirko


  

Betrifft: AW: excel-makro in vba code umwandeln von: Josef Ehrensberger
Geschrieben am: 19.12.2009 09:18:05

Hallo Mirko,

Möglichkeiten eine Fortschrittsanzeigen einzubauen gibt es unzählige.

Du musst dir aber darüber im Klaren sein, das jede Fortschrittsanzeigen die
Laufzeit des Makros verlängert.

Hier eine Möglichkeit.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Berechnung_MFH()
  Dim lngCount As Long
  
  With Sheets("Bemessung")
    
    For lngCount = 1 To 100
      .Scenarios(CStr(lngCount)).Delete
      ProgressBar lngCount, sMsg = "Szenarios werden gelöscht!" & vbLf & "Bitte warten"
    Next
    
    For lngCount = 1 To 100
      .Scenarios.Add Name:=CStr(lngCount), _
        ChangingCells:=.Range("F24"), _
        Values:=.Cells(31, lngCount + 3), _
        Comment:="Erstellt von " & Environ("USERNAME") & _
        " am " & Format(Date, "dd.MM.yyyy"), _
        Locked:=True, Hidden:=False
      ProgressBar lngCount, sMsg = "Szenarios werden erstellt!" & vbLf & "Bitte warten"
    Next
    
    .Scenarios.CreateSummary ReportType:=xlStandardSummary, _
      ResultCells:=.Range("J12:J17")
    
    .Range("E8:CZ13").Copy .Range("D63")
    .Range("F24").FormulaR1C1 = "=RC[-4]"
    
  End With
  
End Sub

Public Sub ProgressBar(ByVal dActual As Double, Optional ByVal dMax As Double = 100, Optional ByVal sMsg As String = "Bitte warten...")
  Dim v As Double, l As Double, t As Double, h As Double, w As Double, wv As Double
  Dim sBack As Shape, sBarFrame As Shape, sBar As Shape, sText As Shape, sPerc As Shape, sProg As Shape
  
  
  w = 250
  wv = w - 20
  h = 120
  l = (Application.Left + (Application.Width / 2)) - (w / 2)
  t = (Application.Top + (Application.Height / 3)) - (h / 2)
  
  With ActiveSheet
    On Error Resume Next
    Set sBack = .Shapes("PBack")
    On Error GoTo 0
    
    If sBack Is Nothing Then
      
      dummy
      
      Set sBack = .Shapes.AddShape(msoShapeRectangle, l, t, w, h)
      
      With sBack
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Line.ForeColor.RGB = RGB(0, 0, 255)
        .Line.Style = msoLineThinThick
        .Line.Weight = 4.5
        .Name = "PBack"
        .OnAction = "dummy"
      End With
      
      Set sBarFrame = .Shapes.AddShape(msoShapeRectangle, l + 10, t + h - 24, wv, 14)
      
      With sBarFrame
        '.Fill.Visible = msoFalse
        .Fill.ForeColor.RGB = RGB(224, 224, 255)
        '.Line.Visible = msoFalse
        .Line.ForeColor.RGB = RGB(0, 0, 192)
        .Line.Weight = 1
        .Name = "PFrame"
        .OnAction = "dummy"
      End With
      
      Set sBar = .Shapes.AddShape(msoShapeRectangle, l + 11, t + h - 23, 0, 13)
      
      With sBar
        .Fill.ForeColor.RGB = RGB(0, 0, 255)
        .Line.Visible = msoFalse
        .Name = "PBar"
        .OnAction = "dummy"
      End With
      
      Set sPerc = .Shapes.AddTextbox(msoTextOrientationHorizontal, l + 10, t + h - 40, wv, 14)
      
      With sPerc
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        With .TextFrame
          With .Characters.Font
            .Name = "Tahoma"
            .FontStyle = "Standard"
            .Size = 10
            .ColorIndex = 5
          End With
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlCenter
        End With
        .Name = "PPerc"
        .OnAction = "dummy"
      End With
      
      Set sText = .Shapes.AddTextbox(msoTextOrientationHorizontal, l + 10, t + 10, wv, h - 50)
      
      With sText
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        With .TextFrame
          With .Characters.Font
            .Name = "Tahoma"
            .FontStyle = "Standard"
            .Size = 10
            .ColorIndex = 5
          End With
          .Characters.Text = sMsg
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlCenter
        End With
        .Name = "PText"
        .OnAction = "dummy"
      End With
      
    End If
    
    v = dActual / dMax
    
    If v < 1 Then
      .Shapes("PPerc").TextFrame.Characters.Text = Format(v, "0 %")
      If .Shapes("PText").TextFrame.Characters.Text <> sMsg Then .Shapes("PText").TextFrame.Characters.Text = sMsg
      .Shapes("PBar").Width = (wv - 0.5) * v
      DoEvents
    Else
      .Shapes("PPerc").TextFrame.Characters.Text = Format(1, "0 %")
      .Shapes("PBar").Width = (wv - 0.5)
      DoEvents
      dummy
    End If
    
  End With
  
End Sub

Private Sub dummy()
  On Error Resume Next
  With ActiveSheet
    .Shapes("PBack").Delete
    .Shapes("PBar").Delete
    .Shapes("PFrame").Delete
    .Shapes("PText").Delete
    .Shapes("PPerc").Delete
  End With
  On Error GoTo 0
End Sub



Gruß Sepp



  

Betrifft: Codekorrektur! von: Josef Ehrensberger
Geschrieben am: 19.12.2009 10:08:30

Hallo Mirko,

mir ist ein kleiner Fehler unterlaufen.

Statt

sMsg = "Szenarios werden....
muss es
sMsg:="Szenarios werden....

heißen!


Gruß Sepp



  

Betrifft: AW: Codekorrektur! von: Mirko
Geschrieben am: 19.12.2009 16:18:32

Hayllo Sepp,
-schon jetzt einmal danke für den Code. Ich werde mich heute etwas später damit beschäftigen können und gebe dir dann ein Feedback.

Bis später Gruß Mirko


Beiträge aus den Excel-Beispielen zum Thema "excel-makro in vba code umwandeln"