Summe unter Zellenblock aber variabel - per VBA

[JoSchi]

Guten Abend allerseits,
ich habe in einem anderen Forum schon mal vor 3 Tagen gepostet, aber dort keine VBA-Lösung bekommen, warum auch immer, deshalb versuch ich´s hier nun auch.
Nur damit sich niemand wundert, wenn ihm mein Post im Office-Lösungen.de auffällt.
Ich hab dort auch geschrieben, dass ich mir in einem weiteren Forum Rat erfrage.

Mein Problem:
ich habe in einer Tabelle (wie abgebildet, und Datei im Anhang) Zahlenblöcke mit Werten von Dingen
von 1 bis max. 9 Posten untereinander, in diesen 6 Spalten plus der Bezeichnungen in Spalte "A:A".

Ich suche nun ein Makro, welches mir die Summe eines Blockes liefert, egal ob es 1 Posten ist, oder 9.
Das heißt, ich positioniere den Curser unter dem Block z.B. "A14" und starte das Makro welches mir den Text: "ZWS" eintragen soll, dann die erste summe in "C14" die Zweite in "D14" usw... wie meine Makros auch, nur eben soll sich das Makro in den Summenzellen selbst die Anzahl Summanden suchen.

Per Hand macht das Autosumme - aber die Auswahl bis zu nächsten leeren Zelle bekomme ich nicht in VBA gebacken.

Zur Zeit hab ich für jede Anzahl Posten (Zellen untereinander) ein Makro mit nem Button verbunden, also 9 Makros.

Das müsste doch auch anders gehen? Könnt Ihr mir vielleicht helfen?

Vielen Dank im Voraus.

Hier mal die Tabelle als Bild und als Datei

  Tabelle-Obst-01.xlsm (Größe: 17,36 KB / Downloads: 7)
   

Und hier noch die Makros (nur als Beispiel wie ich es momentan habe)

Code:

Sub ZWS_1_Copy()
'
   With ActiveCell
       .FormulaR1C1 = "ZWS"
       .Range("C1:G1").FormulaR1C1 = "=SUM(R[-1]C:R[-1]C)"  ' ! hier steckt wohl mein Problem?
       .Offset(0, 0).Range("A1").Select
   End With
End Sub

Sub ZWS_2_Copy()
'
   With ActiveCell
       .FormulaR1C1 = "ZWS"
       .Range("C1:G1").FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
       .Offset(0, 0).Range("A1").Select
   End With
End Sub

Sub ZWS_3_Copy()
'
   With ActiveCell
       .FormulaR1C1 = "ZWS"
       .Range("C1:G1").FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
       .Offset(0, 0).Range("A1").Select
   End With
End Sub
Sub ZWS_4_Copy()
'
   With ActiveCell
       .FormulaR1C1 = "ZWS"
       .Range("C1:G1").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
       .Offset(0, 0).Range("A1").Select
   End With
End Sub

[GMG-CC]

Moin,
auch wenn du dieses Crossposting im Nachbarforum angekündigt hast: Information ist keine Einbahnstraße!

[JoSchi]

Moin,
auch wenn du dieses Crossposting im Nachbarforum angekündigt hast: Information ist keine Einbahnstraße!

? - kannst Du mir das erklären ?
(also ich versteh jetzt echt nicht, was Du damit meinst.)
Danke !

Edit: kann es sein, dass Du meine ersten 3 Zeilen oben übersehen hast ?
Dort habe ich bereits darauf hingewiesen, dass ich dort gepostet habe.
Also Einbahnstrasse ist für mich nicht verständlich.

[GMG-CC]

Edit: kann es sein, dass Du meine ersten 3 Zeilen oben übersehen hast ?

Sorry, habe ich in der Tat. Insofern: Kommando zurück.
Ich hatte den haupt-Teil kurz gelesen und dann (aus jetziger Sicht- falsch reagiert.
Dennoch ein Hinweis: Nenne auch den Link zum Forum und Beitrag, damit wir Helfer und orientieren können.

[Kuwer]

Hallo Jürgen,

Sub ZWS_Copy()
  Dim rngB As Range
  With ActiveCell
    Set rngB = .Offset(-1).CurrentRegion
    .Value = "ZWS"
  End With
  Set rngB = rngB.Offset(, 1).Resize(rngB.Rows.Count, rngB.Columns.Count - 1)
  rngB.Offset(rngB.Rows.Count).Resize(1).FormulaR1C1 = "=SUM(R[-" & rngB.Rows.Count & "]C:R[-1]C)"
End Sub

Gruß Uwe

[JoSchi]

Herzlichen Dank Uwe !
Schönes Wochenende !

[JoSchi]

Sorry, habe ich in der Tat. Insofern: Kommando zurück.
Ich hatte den haupt-Teil kurz gelesen und dann (aus jetziger Sicht- falsch reagiert.
Dennoch ein Hinweis: Nenne auch den Link zum Forum und Beitrag, damit wir Helfer und orientieren können.

Alles klar Günter - kann passieren.
Die direkte Verlinkung atte ich in Erwägung gezogen, aber 1. wusste ich nicht wie das hier oder dort gesehen wird und
2. gabs in meinem Post dort keine Information in der Sache, die ich hier nicht benannt hätte.

Schwamm drüber.... schönes Wochenende.

[JoSchi]

Hallo Jürgen,

Sub ZWS_Copy()
  Dim rngB As Range
  With ActiveCell
    Set rngB = .Offset(-1).CurrentRegion
    .Value = "ZWS"
  End With
  Set rngB = rngB.Offset(, 1).Resize(rngB.Rows.Count, rngB.Columns.Count - 1)
  rngB.Offset(rngB.Rows.Count).Resize(1).FormulaR1C1 = "=SUM(R[-" & rngB.Rows.Count & "]C:R[-1]C)"
End Sub

Gruß Uwe

Hallo Uwe,

Das funzt bei mir jetzt noch nicht so wirklich.

Und zwar, meckert er bei: Dim rngB As Range
und bei:  Set rngB = .Offset(-1).CurrentRegion
sowie bei:   End With

Da bekomm ich  1) Kompilierungsfehler 2) Syntaxfehler

Ähnlichen Code hatte ich schon bei Herber gesehen und der lief auch nicht.

Oder ich bin zu dusselig, den Code anzupassen?

Wäre schön, wenn Du nochmal danach gucken könntest? !

Danke schon mal!

[Kuwer]

Hallo Jürgen,

wenn es schon bei Dim rngB As Range aussteigt, ist bei Dir grundlegend etwas faul. Excel- und/oder Windowsneustart hast Du schon gemacht?
Aber unabhängig davon war der Code auch nur für einen Block, abhängig von der aktiven Zelle, welche eine der Zellen sein muss, die mit "ZWS" gefüllt werden.

Hier nun der Code für alle Blöcke unabhängig von der aktiven Zelle:

Code:

Sub ZWS_Alle_Copy()
  Dim lngZ As Long, rngB As Range
  
  If Application.WorksheetFunction.CountA(Columns(1)) Then
    Set rngB = Columns(1).SpecialCells(xlCellTypeConstants)
    For lngZ = 2 To rngB.Areas.Count
      With rngB.Areas(lngZ)
        If .Cells(.Cells.Count).Value <> "ZWS" Then
          .CurrentRegion.Resize(1, .CurrentRegion.Columns.Count - 2).Offset(.Rows.Count, 2).FormulaR1C1 = "=SUM(R[-" & .Rows.Count & "]C:R[-1]C)"
          .Cells(.Cells.Count).Offset(1).Value = "ZWS"
        End If
      End With
    Next lngZ
  End If
End Sub

Gruß Uwe

[JoSchi]

Hallo Jürgen,

wenn es schon bei Dim rngB As Range aussteigt, ist bei Dir grundlegend etwas faul. Excel- und/oder Windowsneustart hast Du schon gemacht?
Aber unabhängig davon war der Code auch nur für einen Block, abhängig von der aktiven Zelle, welche eine der Zellen sein muss, die mit "ZWS" gefüllt werden.

Hier nun der Code für alle Blöcke unabhängig von der aktiven Zelle:

Code:

Sub ZWS_Alle_Copy()
 Dim lngZ As Long
 Dim rngB As Range
 
 If Application.WorksheetFunction.CountA(Columns(1)) Then
   Set rngB = Columns(1).SpecialCells(xlCellTypeConstants)
 End If
 If Not rngB Is Nothing Then
   For lngZ = 2 To rngB.Areas.Count
     With rngB.Areas(lngZ)
       If .Cells(.Cells.Count).Value <> "ZWS" Then
         .CurrentRegion.Resize(1, .CurrentRegion.Columns.Count - 2).Offset(.Rows.Count, 2).FormulaR1C1 = "=SUM(R[-" & .Rows.Count & "]C:R[-1]C)"
         .Cells(.Cells.Count).Offset(1).Value = "ZWS"
       End If
     End With
   Next lngZ
 End If
End Sub

Gruß Uwe

Hi Uwe,
dass bei mir grundlegend etwas "faul" ist, sagen viele  

Hab jetzt den Rechner neu gestartet und werd dann gleich mal probieren.

Danke Dir schon mal !
Meld mich wieder mit neuesten Erkenntnissen.

Grüße


SUPER ! - Klappt !!!
Danke Uwe