Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 22:08:10
Auflisten in Spalte VBA
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
23.04.2024 21:29:56
Bestimmte Zellen auf andere Arbeitsblätter kopieren
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1124to1128
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1124to1128
1124to1128
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

excel-makro in vba code umwandeln

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

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: excel-makro in vba code umwandeln
18.12.2009 23:06:30
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

Gruß Sepp

Anzeige
AW: excel-makro in vba code umwandeln
18.12.2009 23:45:11
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
Anzeige
AW: excel-makro in vba code umwandeln
19.12.2009 08:21:27
Josef
Hallo Mirko,
schau mal auf die Statusleiste, da siehst du den Fortschritt.
Gruß Sepp

AW: excel-makro in vba code umwandeln
19.12.2009 08:47:56
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
Anzeige
AW: excel-makro in vba code umwandeln
19.12.2009 09:18:05
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

Gruß Sepp

Anzeige
Codekorrektur!
19.12.2009 10:08:30
Josef
Hallo Mirko,
mir ist ein kleiner Fehler unterlaufen.
Statt 

sMsg = "Szenarios werden....
muss es 

sMsg:="Szenarios werden....

heißen!
Gruß Sepp

AW: Codekorrektur!
19.12.2009 16:18:32
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

309 Forumthreads zu ähnlichen Themen

VBA - Zelle kopieren bis Wert einer Zelle null ist
Schulze

Halli Hallo,
ich bin ziemlicher Neuling in VBA. Daher würde ich euch bitten mir bei meiner Fragestellung zu helfen und zwar wie folgt: Ich möchte aus einer Tabelle aller Zellen kopieren, bis der Wert einer Zelle 0 annimmt. Diesen bestimten Bereich möchte ich in einer neuen Datei abspeichern...
19.08.2008 08:39:35
Thread-ID: 1002782
17 Beiträge
Anzeige
Zelleninhalt mit VBA suchen
Tom

Hallo
zum Feierabend noch mal fix ne Frage
ich möchte in einem anderen sheet, in einer anderen Tabelle etwas suchen und danach 4 Zellen nach links gehen und den Wert kopieren...
Dim strActiveCell As String
Dim rFound As Range
Tabellenname = ActiveSheet.Name
Tabellenname...
04.09.2008 16:41:17
Thread-ID: 1007457
4 Beiträge
Beim Kopieren eines Tabellenblattes den VBA-Code e
Alfi

Hallo Excel-Gemeinde!
ich habe eine mehrblättrige Datei, per Makro kopiere ich ein Blatt und speichere dieses unter neuem Namen ab.
Dieses Blatt soll aber nicht mehr den VBA-Code der ursprübglichen Datei enthalten, sprich ein Blatt ohne Makros.
Wer kann mir helfen?
So sieht der...
09.09.2008 09:58:00
Thread-ID: 1008333
8 Beiträge
Anzeige
erzwungener zeilenumbruch in Zelle
Lars

Hallo,
obwohl ich schon viel mit Excel gemacht habe, tauchen doch immer wieder Fragen auf:
Gibt es eine Möglichkeit, in einer Zelle einen Zeilenumbruch manuell einzufügen, ohne dass man bereits am Zellenende ist?
Ich denke, dass ist eine eher dumme Frage, aber ich habe derzeit keine...
02.10.2008 15:40:00
Thread-ID: 1013906
4 Beiträge
Array-Formel in VBA-Code umwandeln?
Robert

Hallo,
ich bräuchte bitte eure Hilfe.
Hab folgende Formel...
Selection.FormulaArray = _
=IF(ROW(R[-107]C[-3])>COUNTA('1'!R5C[4]:R200C[4]),"""",INDEX('1'!R5C4:R200C4,SMALL(IF('1'!R5C[4]:R200C[4]<>"""",ROW(R1:R196),""""),ROW(R[-107]C[-3]))))"
Mein Problem ist, dass ic...
26.10.2008 10:56:28
Thread-ID: 1019326
13 Beiträge
Code per VBA in "Diese Arbeitsmappe"
Timo

Hallo,
mir ist bekannt, wie ich per VBA ein neues Modul anlegen und eine Sub erzeugen kann.
Ich möchte nun aber per VBA eine sub in "Diese Arbeitsmappe" erzeugen und mit einer zweiten Prozedur wieder löschen.
Geht das?
Ich habe im Archiv nichts relevantes hierzu gefunden.
V...
29.10.2008 11:37:00
Thread-ID: 1020207
6 Beiträge
VBA heutiges Datum finden und Inhalt der Zelle prü
NeptunesChild

Hallo Leutz,
ich möchte in einer Zeiterfassung auf einem Monatsblatt das heutige Datum finden, dann in einer anderen Spalte (5 weiter links) eine Uhrzeit eintragen. Zuvor soll aber die Kontrolle erfolgen, ob in der Zelle bereits etwas steht und ob dies kleiner ist, als die aktuelle Zeit. We...
06.11.2008 15:38:08
Thread-ID: 1022323
3 Beiträge
Leere Zelle suchen, Wert eintragen VBA
andreas

Hallo zusammen,
habe ein kleines Formular mit zwei "Command-Button".
Bei drücken von "Zufügen" soll die nächst leere Zelle im Bereich "F3:J3500" gesucht werden und ein "x" eingetragen werden.
Bei drücken von "Entfernen" suche im selben Bereich die letzte ausgefüllte Zelle und diese...
19.11.2008 11:57:07
Thread-ID: 1025960
2 Beiträge
Anzeige

Links zu Excel-Dialogen

Frame TextBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
16
5
3
7
4
3
12
5
2
1
2
7
6
2
5
3
2
2
4
2
4
4
7
4
4