Automatische Berechnung - Excel-Makro

Dieses Thema Automatische Berechnung - Excel-Makro im Forum "Microsoft Office Suite" wurde erstellt von iggboert, 25. Juli 2006.

Thema: Automatische Berechnung - Excel-Makro Hi, hab da mal ein kleines Problem für nen pfiffigen Makroprogrammierer ;D Habe eine Tabelle in eine ziemlich...

  1. Hi, hab da mal ein kleines Problem für nen pfiffigen Makroprogrammierer ;D

    Habe eine Tabelle in eine ziemlich komplexen Excel-Datei eingefügt. Mit hilfe dieser Exceldatei kann man verschiedenen Kosten gegenrechnen. Allerdings nur für 3 Szenarien auf einmal. Nun würde ich allerdings gerne gleich 50 (oder mehr) Szenarien auf einmal ausrechnen.
    Um die Eingabe zu erleichtern, habe ich die relevanten Daten in die o.g. Tabelle eingegeben.
    Hab da ganze auch mal als Beispiel zum Verstehen als jpg angehängt.

    [​IMG]
    gelb --> Bereich der geändert wird.
    rot --> Bereich wird nicht geändert, nur im seltensten Fall
    orange --> Ergebnis

    [​IMG]
    Hier werden sehr viele Szenarien eingetragen.

    Beide Tabellen befinden sich auf einem Blatt!
    Diese Szenarien sollen nun in kosten-ergebnis1-Tabelle automatisch übertragen werden. Die Ergebnisse aus den Szenarien sollen nun wieder unter die kostenergebnis2-Tabelle übertragen werden.

    Da ich nur bei kosten-ergebnis1-Tabelle nur 2 Spalten zur Verfügung hab, ist es von Hand etwas mühselig.

    Wäre es nun möglich per Knopfdruck-Makro diese Aufgabe automatisch zu erledigen?

    Bin schon gespannt auf eure Antworten :D
     
  2. Hallo iggboert,

    ich hab die mal 4 Makros für die Aufgaben geschrieben.
    4 Knöpfe anlegen, Makros zuordnen und ausprobieren.

    Feedback geben ... , dann werden wir sehen, wo noch die Feile angesetzt werden muß.

    Gruß Matjes :)
    Code:
    Option Explicit
    
      Private Const RANGE_ERGEBNIS_VON_ZEILE = 25
      Private Const RANGE_ERGEBNIS_BIS_ZEILE = 28
    
      Private Const ZEILE_ZIEL_ERGEBNIS = 14
    
      Private Const RANGE_DATENQUELLE_VON_ZEILE = 3
      Private Const RANGE_DATENQUELLE_BIS_ZEILE = 12
      
      Private Const RANGE_DATENZIEL_ZEILE = 3
    
      Private Const cTXT_FRAGE_DATEN_AUS_WELCHER_SPALTE = _
                    Aus welcher Spalte sollen die Daten kopiert werden ? & vbLf & _
                    Bitte geben Sie den Buchstaben der Spalte ein.
      Private Const cTXT_FRAGE_ERGEBNIS_IN_WELCHER_SPALTE = _
                    In welche Spalte sollen die Ergebnis-Daten kopiert werden ? & vbLf & _
                    Bitte geben Sie den Buchstaben der Spalte ein.
    '**********************************************************************
    Sub Daten_InSpalte_B_Kopieren()
      Call Daten_InSpalte_Kopieren(B)
    End Sub
    '**********************************************************************
    Sub Daten_InSpalte_C_Kopieren()
      Call Daten_InSpalte_Kopieren(C)
    End Sub
    '**********************************************************************
    Private Function Daten_InSpalte_Kopieren(sZielspalte As String)
      
      Dim sSpalte As String
      
      If Not SpaltenEingabe(sSpalte, _
                            cTXT_FRAGE_DATEN_AUS_WELCHER_SPALTE, _
                            Daten kopieren in Spalte  & sZielspalte _
                            ) Then Exit Function
      
      Range(sSpalte & RANGE_DATENQUELLE_VON_ZEILE & : & _
            sSpalte & RANGE_DATENQUELLE_BIS_ZEILE).Copy
      Range(sZielspalte & RANGE_DATENZIEL_ZEILE).Select
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
                             SkipBlanks:=False, Transpose:=False
    End Function
    '**********************************************************************
    Sub Ergebnis_SpalteB_Kopieren()
      Call Ergebnis_Spalte_Kopieren(B)
    End Sub
    '**********************************************************************
    Sub Ergebnis_SpalteC_Kopieren()
      Call Ergebnis_Spalte_Kopieren(C)
    End Sub
    '**********************************************************************
    Private Function Ergebnis_Spalte_Kopieren(sQuellSpalte As String)
      
      Dim sSpalte As String
      
      If Not SpaltenEingabe(sSpalte, _
                            cTXT_FRAGE_ERGEBNIS_IN_WELCHER_SPALTE, _
                            Daten kopieren aus Spalte  & sQuellSpalte _
                            ) Then Exit Function
      
      Range(sQuellSpalte & RANGE_ERGEBNIS_VON_ZEILE & : & _
            sQuellSpalte & RANGE_ERGEBNIS_BIS_ZEILE).Copy
      Range(sSpalte & ZEILE_ZIEL_ERGEBNIS).Select
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
                             SkipBlanks:=False, Transpose:=False
    End Function
    '**********************************************************************
    Private Function SpaltenEingabe(sSpalte As String, _
                                    sPrompt As String, _
                                    sTitle As String) As Boolean
      SpaltenEingabe = False
      sSpalte = 
      Do
        sSpalte = InputBox(sPrompt, sTitle, sSpalte)
        If sSpalte =  Then Exit Function->Abbruch oder terminate
        sSpalte = UCase(sSpalte)
        Select Case sSpalte
          Case F, G, H, I, J:  SpaltenEingabe = True: Exit Do->zulässig
          Case Else: MsgBox Spaltenangabe-> & sSpalte &-> unzlässig.
        End Select
      Loop
    End Function
     
  3. Hey Matjes, danke.

    Das klappt soweit schon ganz gut! Nun war das aber nicht mein eigentliches Problem. Es könnte sein, dass ich ca 200 Spalten kopieren muss. Da ist es zwar schon recht hilfreich nur Knöpfe zu drücken, und den jeweiligen Buchstaben für die Spalte anzugeben, doch auf die Dauer auch recht heftig.

    Wirklich Klasse wäre es, wenn dies für eine Range an Spalten also sagen wir ca 50 auf einmal möglich wäre.

    Des weiteren wird ja immer das Ergebnis unter die vorherige Datenspalte kopiert. Ist es evtl. möglich den Spaltenbuchstaben zu speichern, und dann ohne weitere Nachfrage das Ergebnis reinzukopieren?
    Wäre es vielleicht sogar möglich den Kopiervorgang pro Rechnung auf einen Button zu legen?
    Oder wartet des Makro nicht, bis die dahintersteckende Rechnung zu Ende ist?

    Eine Frage/Bitte nach der Anderen. Hoffe du bist nicht verschreckt!

    Gruss
    Igge
     
  4. Hallo iggboert,

    Die Ergebnisse werden mit Formeln auf dem gleichen Blatt erstellt.
    Dann kann man das in einen Rutsch machen.

    Warum sind 2 Spalten für die Berechnung/Ergebnisse vorhanden ?
    Wenn sie gleichberechtigt sind, lassen wir eine davon (C) leer und
    fahren das nur über Spalte B ab.

    Ich werde mal einen Makro zusammenstellen, der alle Spalten ab F3 nach Daten sucht, diese in Spalte B kopiert, eine calculation anstößt und dann die Ergebnisse in die entsprechende Spalte zurückschreibt.

    Gruß Matjes :)
     
  5. Diese Version geht alle Spalten nacheinander im Datenspeicherbereich durch:
    - kopiert die Daten in den Berechnungsbereich
    - stößt die Calculation an
    - kopiert die Ergebnisse in die entsprechende Spalte im Datenspeicherbereich

    Schluß ist, wenn Kosten 1 im Datenbereich leer ist.

    Gruß Matjes :)
    Code:
    Option Explicit
    
     ->Berechnungsbereich
      Private Const SPALTE_BERECHNUNG_B = 2
      Private Const ZEILE_VON_BERECHNUNG_DATEN1 = 3
      Private Const ZEILE_BIS_BERECHNUNG_DATEN1 = 12
      Private Const ZEILE_VON_BERECHNUNG_ERGEBNIS = 25
      Private Const ZEILE_BIS_BERECHNUNG_ERGEBNIS = 28
      
     ->Datenspeicherbereich
      Private Const SPALTE_AB_DATENSPEICHER = 6
      Private Const ZEILE_VON_DATENSPEICHER_DATEN1 = 3
      Private Const ZEILE_BIS_DATENSPEICHER_DATEN1 = 12
      Private Const ZEILE_VON_DATENSPEICHER_ERGEBNIS = 14
      Private Const ZEILE_BIS_DATENSPEICHER_ERGEBNIS = 17
    
    Sub DatenKopierenBerechnenErgebnisZurueckKopieren()
    
      Dim lSpSpeicher As Long
    
     ->Solange Spalten mit Daten im Speicherbereich vorhanden sind
      lSpSpeicher = SPALTE_AB_DATENSPEICHER
      Do
       ->keine weiteren Daten im Datenspeicher?
        If Cells(ZEILE_VON_DATENSPEICHER_DATEN1, lSpSpeicher).Value =  Then Exit Do
        
       ->Daten aus Datenspeicher in Berechnungsbereich kopieren
        Range(Cells(ZEILE_VON_DATENSPEICHER_DATEN1, lSpSpeicher), _
              Cells(ZEILE_BIS_DATENSPEICHER_DATEN1, lSpSpeicher)).Copy
        Range(Cells(ZEILE_VON_BERECHNUNG_DATEN1, SPALTE_BERECHNUNG_B), _
              Cells(ZEILE_VON_BERECHNUNG_DATEN1, SPALTE_BERECHNUNG_B)).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
                               SkipBlanks:=False, Transpose:=False
                               
       ->Berechnung anstossen
        Calculate
    
       ->Ergebnisse aus dem Berechnungsbereich in den Datenspeicherbereich kopieren
        Range(Cells(ZEILE_VON_BERECHNUNG_ERGEBNIS, SPALTE_BERECHNUNG_B), _
              Cells(ZEILE_BIS_BERECHNUNG_ERGEBNIS, SPALTE_BERECHNUNG_B)).Copy
        Range(Cells(ZEILE_VON_DATENSPEICHER_ERGEBNIS, lSpSpeicher), _
              Cells(ZEILE_VON_DATENSPEICHER_ERGEBNIS, lSpSpeicher)).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
                               SkipBlanks:=False, Transpose:=False
        
       ->nächste Spalte Datenspeicher
        lSpSpeicher = lSpSpeicher + 1
      Loop
    End Sub
       
     
  6. hey, des hört sich ja gut an! Genausowas hab ich gesucht! Schon mal tausend dank im vorraus!

    hab bloss momentan keine Zeit des auszuprobieren, schreib jetzt Montag und Freitag prüfungen.
    Danach melde ich mich wieder.
     
  7. Hallo iggboert,

    es sollte schon laufen ;)

    Wenn nicht, wäre morgen noch eine Möglichkeit Bugs zu beheben.
    Ansonsten erst in 14 tagen - wegen urlaub - juchuuuu :D

    Gruß Matjes :)
     
Die Seite wird geladen...

Automatische Berechnung - Excel-Makro - Ähnliche Themen

Forum Datum
Automatische Updates Windows 10 Forum 11. Aug. 2016
Automatisches Downgrade auf Windows 7 nach Installation von Windows 10 Windows 10 Forum 14. Juli 2016
Win7 automatische Deinstallation von Patches...durch Windows... ??? Windows 7 Forum 19. Mai 2016
keine automatische Erkennung bei neuem DVD-Laufwerk Windows 7 Forum 24. Sep. 2015
Automatische Benachrichtigung auf dem Desktop erzeugen Windows 7 Forum 2. Apr. 2015