Excel 2013 VBA: Mal wieder Doppelklick

[sharky51]

Hallo verehrtes Forum,
würde gerne mal wieder um Eure Hilfe bei folgender Aufgabe bitten.

Ich habe eine Tabelle die folgendermaßen aufgebaut ist:

Tabelle1

	A	B	C
1	1	7	13
2	2	8	14
3	3	9	15
4	4	10	16
5	5	11	17
6	6	12	18
7	21	57	93
8	171

verbundene Zellen

A8:C8

verwendete Formeln
Zelle	Formel	Bereich	N/A
A7:C7	=SUMME(A1:A6)
A8	=SUMME(A7:C7)

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 21.01 einschl. 64 Bit

Bei einem Doppelklick in eine der Spalten, in Zeile 7, sollen automatisch alle Zellinhalte der Spalte aufaddiert werden.
Als zweite und bevorzugte Variante sollte bei einem Doppelklick in die verbundene Zelle A8:C8 in der jeweiligen darüberliegenden Zelle wiederum die Spaltensumme eingetragen werden und anschließend die Gesamtsumme aller Spalten in der verbundenen Zelle A8:C8 eingetragen werden.

Die Anzahl der Spalten kann aber variieren und somit auch die Länge der verbundenen Zelle z.B A8:J8

Vielleicht habt Ihr eine Idee wie man das mittels VBA umsetzen kann?

Vielen Dank!

[Steffl]

Hallo Erich,

vielleicht so?

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

   Cancel = True
   If Not Intersect(Rows(7), Target) Is Nothing Then
      Target = Application.WorksheetFunction.Sum(Target.Offset(-6).Resize(6))
   End If
   If Target.Address(0, 0) = "A8" Then
      Target = Application.WorksheetFunction.Sum(Cells(7, 1).Resize(, Cells(7, 1).End(xlToRight)))
   End If
End Sub

[GMG-CC]

Moin,

ich habe das etwas anders verstanden. Darum meine Version, die automatisch die belegten Spalten berechnet:

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim lCol As Integer
  Dim rngZe7 As Range, rngZe8 As Range, c As Range
 
  lCol = Cells(1, Columns.Count).End(xlToLeft).Column
  'Alternative, falls Zeile 1 nicht immer die längste ist
'   lCol = Cells.Find(What:="*", SearchOrder:=xlByColumns, _
   SearchDirection:=xlPrevious).Column
  Set rngZe7 = Range(Cells(7, 1), Cells(7, lCol))
  Set rngZe8 = Range(Cells(8, 1), Cells(8, lCol))
 
  If Not Intersect(rngZe8, Target) Is Nothing Then
     For Each c In rngZe7
        c = WorksheetFunction.Sum(Range(Cells(1, c.Column), Cells(6, c.Column)))
     Next c
     Cells(8, 1) = WorksheetFunction.Sum(Range(Cells(7, 1), Cells(7, lCol)))
  End If
  Cancel = True
End Sub

[sharky51]

Hallo Stefan,
nein so habe ich mir das nicht vorgestellt.
Trotzdem danke für Deinen Vorschlag.

Hallo Günther,
das sieht gut aus. Ich möchte aber noch ein bisschen testen.
Melde mich dann wieder.

Vielen Dank!

[sharky51]

Hallo Günther,

eine Frage noch:
Warum das "Cancel = True" am Ende der Routine? Ist das notwendig?
Nach einem Doppelklick ist keine weitere Aktion möglich, d.h. es ist irgendwie blockiert.

Kommentiere ich die Zeile aus erfolgt wie gewünscht die Berechnung.

[GMG-CC]

Moin Erich,

der Aufruf der Prozedur lautet ja so:

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

es wird also Cancel als Bool'scher Wert automatisch übergeben. Und ich habe das aus Gewohnheit wieder auf True gesetzt, aber es muss bzw. sollte hier nicht nicht sein. Also: Raus damit ...

[GMG-CC]

Nochmals sorry,
solch ein Lapsus (mit dem Cancel) sollte mir nicht passieren. Ich war leider ziemlich abgelenkt durch die sich immer wieder aktualisierenden schrecklichen Nachrichten aus Paris ...

[Kuwer]

Nochmals sorry,
solch ein Lapsus (mit dem Cancel) sollte mir nicht passieren. Ich war leider ziemlich abgelenkt durch die sich immer wieder aktualisierenden schrecklichen Nachrichten aus Paris ...

Hi Günther,

einen "Lapsus" würde ich höchstens darin sehen, das Cancel = True unabhängig von der Bedingung generell gesetzt wird.

Gruß Uwe

[sharky51]

Hallo Günther,

darf ich Dich nochmal löchern?

Wenn ich jetzt mehrere Bereiche habe die ich auf die gleiche Weise (Addition per Doppelklick) bearbeiten will, wie müsste das Makro abgeändert werden.
Die Bereiche habe ich mit Namen benannt. Siehe dazu die angehängte Datei.

Wäre toll wenn Du mir da weiterhelfen könntest.

Vielen Dank!

[GMG-CC]

Moin Erich,

dieser Code sollte deinen Wünschen entsprechen:

Code:

Option Explicit

'Const anzSumBereich = 3 'Anzahl der benannten Summenbereiche

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim lCol As Integer
  Dim rngUnion As Range
 
  lCol = Cells(1, Columns.Count).End(xlToLeft).Column
  Set rngUnion = Application.Union(Range("SumErgebnis1"), Range("SumErgebnis2"), Range("SumErgebnis3"))
  If Not Intersect(rngUnion, Target) Is Nothing Then Call SpaltenSumme(Target.Row - 1, lCol)
End Sub


Sub SpaltenSumme(Zeile, lCol)
  Dim rngSubSum As Range, c As Range, rngData As Range
 
  Select Case Zeile
   Case 7
     Set rngData = Range("Bereich1")
   Case 20
     Set rngData = Range("Bereich2")
   Case Else
     Set rngData = Range("Bereich3")
  End Select
 
  Set rngSubSum = Range(Cells(Zeile, 1), Cells(Zeile, lCol))
  For Each c In rngSubSum
     Cells(Zeile, c.Column) = WorksheetFunction.Sum(rngData.Columns(c.Column))
  Next c
  Cells(Zeile + 1, 1) = WorksheetFunction.Sum(rngSubSum)
End Sub