Office: Problem mit Vba Berechnung

Hallo,
ich habe Folgendes Problem welches ich leider nach längerem suchen im netz und diversen Foren leider nicht endgültig lösen konnte

Ich möchte in verschiedenen Listen, welche ich über "Gültigkeit" erstellt habe, Optionen auswählen, welche mir dann unter diese Listen entsprechende Werte kopieren das ganze soll das in etwa so aussehen:
(die Listen liegen auf D16 und D22 im Beispiel und das ganze sollte auf Excel 2003 laufen wenn das möglich wäre)



dazu habe ich folgendes in vba eingefügt:

Code:

Private Sub Worksheet_Calculate()

EnableCalculation = True

If Range("D16") = Range("G16") Then
    Range("G17:G19").Copy
    Range("D17:D19").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

ElseIf Range("D16") = Range("H16") Then
    Range("H17:H19").Copy
    Range("D17:D19").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
            
ElseIf Range("D16") = Range("I16") Then
    Range("I17:I19").Copy
    Range("D17:D19").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

End If

If Range("D22") = Range("G22") Then
    Range("G23:G25").Copy
    Range("D23:D25").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

ElseIf Range("D22") = Range("H22") Then
    Range("H23:H25").Copy
    Range("D23:D25").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
            
ElseIf Range("D22") = Range("I22") Then
    Range("I23:I25").Copy
    Range("D23:D25").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
End If
End Sub

Die Berechnungen unter Optionen sind auf Automatisch. Wenn ich das ganze unter "Private Sub Worksheet_Change(ByVal Target As Range)" eingebe werden mir zwar die Tabellen kopiert, aber er rechnet bei jedem klick den ich mache immer alles durch und springt wieder auf die Eingefügten Tabelle
Da ich anschließend in der excel noch weitere Berechnungen/Eingaben durchführen möchte ist das schon etwas nervig.

Was könnte man da machen?

Danke schon mal im Voraus
Kon87

 

Hallo,

warum willst du dieses Problem unbedingt mit VBA/Ereignisbehandlung lösen? Das geht ja auch mit 2 einfachen Matrixformeln.
In der beiliegenden Excel-Datei habe ich in den Bereich D17:D19 folgende Formel eingefügt:
{=INDEX(G17:I19;0;VERGLEICH(D16;G16:I16;0))}
und im Bereich D23:D25 folgende Formel:
{=INDEX(G23:I25;0;VERGLEICH(D22;G22:I22;0))}

Vorsicht! Es handelt sich bei beiden Formeln um sogenannte Matrixformeln, erkenntlich an den beiden geschweiften Klammern am Anfang und Ende.
Diese beiden Klammern dürfen nicht direkt eingegeben werden, sondern:
1) Zuerst den Zellbereich markieren, in den die Formel eingegeben werden soll, zB. D17:D19
2) Die Formel, beginnend mit dem = in die Formeleditierzeile eingeben, aber ohne die geschweiften Klammern, zB: =INDEX(G17:I19;0;VERGLEICH(D16;G16:I16;0))
3) Die Formeleingabe nicht mit der bloßen EINGABE-Taste beenden, sondern mit der Tastenkombination UMSCHALT+STRG+EINGABE.
(Daraufhin sind auch plötzlich die geschweiften Klammern sichtbar).

 

Danke erstmal für die Antwort :)

ich wollte das Problem in Vba lösen, da ich mehrere solcher Tabellen mit entsprechendem text und bedingter formatierung drumherum über checkboxen in meiner Tabelle einfügen möchte und der Inhalt der Tabellen gelöscht werden soll wenn die checkbox nicht mehr aktiv ist. Dazu hatte ich folgenden Code genutzt:

Code:

Private Sub CheckBox1_Click()
If CBool(CheckBox1.Value) Then
        Range("B6:B9").Copy
        Range("C16:C19").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False
        Application.CutCopyMode = False
    Else
        Range("C16:D19").ClearContents
        Range("C16:D19").Interior.ColorIndex = xlNone
    End If
End Sub

zudem sollte die Tabelle später an dritte weitergegeben werden und diese sollten sie nicht weiter verändern, aber ich denke das sollte auch mit der Matrixformel gehen.

Gäbe es eine Möglichkeit anstelle des

Code:

 Range("C16:D19").ClearContents

einen Befehl / Makro zu nutzen das den Inhalt der Zelle ohne die Formel entfernt?

Gruß und Danke im Vorraus

 

Hallo,

das - fürchte ich - wird kaum funktionieren, denn das Wesen einer Funktion ist es ja, dass sie einen Wert liefert, wie immer dieser auch aussehen mag.
Als Notlösung fällt mir hier noch ein, dass man zusätzlich einen "Leer"-Monat festlegt, dessen (Spalte-)Zellen lauter leere Zellen enthalten.

 

Hallo,

in der beiliegenden Excel-Datei habe ich eine VBA-Lösung integriert, die auf das Change-Event des Arbeitsblattes reagiert, wobei eine Reaktion nur dann erfolgt, wenn in einer der beiden Zellen D16 bzw D22 eine Änderung erfolgt.
Das Makro funktioniert für beide DropDown-Zellen (D16 bzw. D22): Voraussetzung ist allerdings, dass die zum jeweiligen DropDown gehörigen Daten die gleiche relative Position/Entfernung zum DropDown haben.

Hier der VBA-Change-Event-Handler-Code, enthalten im Codemodul für das Arbeitsblatt "Tabelle1":

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
    If .Address = "$D$16" Or .Address = "$D$22" Then
      Dim rngMo As Range
      Set rngMo = .Offset(0, 3).Resize(1, 3).Find(What:=.Value, LookIn:=xlValues, LookAt:=xlWhole)
      If rngMo Is Nothing Then
        .Offset(1, 0).Resize(3, 1).ClearContents
      Else
        rngMo.Offset(1, 0).Resize(3, 1).Copy
        .Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False
        Application.CutCopyMode = False
      End If
    End If
  End With
End Sub

 

Wow Danke für die Hilfe! :)
das sollte es gewesen sein.