Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Summe unter Zellenblock aber variabel - per VBA
#1
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

.xlsm   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
Antworten Top
#2
Moin,
auch wenn du dieses Crossposting im Nachbarforum angekündigt hast: Information ist keine Einbahnstraße!
Beste Grüße
  Günther

Excel-ist-sexy.de
  …schau doch mal rein!
Der Sicherheit meiner Daten wegen lade ich keine *.xlsm bzw. *.xlsb- Files mehr herunter! -> So geht's ohne!
Antworten Top
#3
(21.07.2017, 19:54)GMG-CC schrieb: 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.
Antworten Top
#4
(21.07.2017, 20:15)JoSchi schrieb: 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.
Beste Grüße
  Günther

Excel-ist-sexy.de
  …schau doch mal rein!
Der Sicherheit meiner Daten wegen lade ich keine *.xlsm bzw. *.xlsb- Files mehr herunter! -> So geht's ohne!
Antworten Top
#5
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
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • JoSchi
Antworten Top
#6
Herzlichen Dank Uwe !
Schönes Wochenende !
Antworten Top
#7
(21.07.2017, 20:34)GMG-CC schrieb: 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.
Antworten Top
#8
(21.07.2017, 20:45)Kuwer schrieb: 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!
Antworten Top
#9
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
Antworten Top
#10
(22.07.2017, 15:05)Kuwer schrieb: 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  Dodgy

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
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste