HERBERS Excel-Forum - das Archiv
Thema: excel-makro in vba code umwandeln | Herbers Excel-Forum
-
Codekorrektur!Josef
-
AW: Codekorrektur!Mirko
excel-makro in vba code umwandeln
mirko
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
AW: excel-makro in vba code umwandeln
Josef
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
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
AW: excel-makro in vba code umwandeln
mirko
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
AW: excel-makro in vba code umwandeln
Josef
Hallo Mirko,
schau mal auf die Statusleiste, da siehst du den Fortschritt.
Gruß Sepp
AW: excel-makro in vba code umwandeln
Mirko
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
AW: excel-makro in vba code umwandeln
Josef
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
' 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
Codekorrektur!
Josef
Hallo Mirko,
mir ist ein kleiner Fehler unterlaufen.
Statt
sMsg = "Szenarios werden....
sMsg:="Szenarios werden....
heißen!
Gruß Sepp
AW: Codekorrektur!
Mirko
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
Dialog-Beispiele
Excel-Beispiele