Anzeige
Archiv - Navigation
708to712
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
708to712
708to712
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Summenbildung in Abhängigkeit Abteilungsbezeichng

Summenbildung in Abhängigkeit Abteilungsbezeichng
20.12.2005 17:46:03
Bernd
Liebe Communitiy,
bitte um Eure Hilfe. Eine Stunde Excel-Archiv durchsuchen hat leider nichts gebracht.
Ich lese per Excel-Makro die Planungsdaten für Projekte von einem Laufwerk aus und stelle die Kosten in einem Excel-Sheet dar.
In Spalte C steht die Abteilungsbezeichnung und der Projektname.
Der Projektnahme ist von dem Abteilungskürzel durch einen Doppelpunkt getrennt.
In den Spalten D - G stehen die Kosten je Jahr.
Nun sollte das Makro einen Abteilungswechsel (Kriterium ist der Doppelpunkt)in Spalte C erkennen und dann vier Leerzeilen einfügen, in die erste Leerzeile die Summe je Spalte eintragen und die Summenzeile grau unterlegen.
Funktion Teilsumme ist nicht geeignet.
Ich habe eine Beispieldatei upgeloadet und ein Lösungsmuster beigefügt.
https://www.herber.de/bbs/user/29458.xls
Vielen Dank!!!!
Bernd

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Summenbildung in Abhängigkeit Abteilungsbezeic
20.12.2005 18:45:24
Josef Ehrensberger
Hallo Bernd!
Versuch mal!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub ProjekteSpliten()
Dim objWS As Worksheet
Dim lngLast As Long, lngRow As Long, lngTmp As Long
Dim intA As Integer, intB As Integer, intCol As Integer

lngRow = 4
lngTmp = lngRow

Set objWS = Sheets("Beispiel") '--> anpassen

With objWS
  
  Do
    intA = InStr(1, .Cells(lngRow, 3), ":") - 1
    intB = InStr(1, .Cells(lngRow + 1, 3), ":") - 1
    
    If intB = -1 Then
      writeSumm objWS, lngRow, lngTmp, intCol
      Exit Do
    ElseIf Left(.Cells(lngRow, 3), intA) <> Left(.Cells(lngRow + 1, 3), intB) Then
      writeSumm objWS, lngRow, lngTmp, intCol
      lngRow = lngRow + 4
      lngTmp = lngRow + 1
    End If
    lngRow = lngRow + 1
  Loop
  
End With

End Sub



Private Function writeSumm(ws As Worksheet, lngRow As Long, lngTmp As Long, intCol As Integer)
With ws
  intCol = 4
  .Rows(lngRow + 1 & ":" & lngRow + 4).Insert
  .Cells(lngRow + 1, 3) = "Summe"
  Do While .Cells(lngRow, intCol) <> ""
    .Cells(lngRow + 1, intCol).Formula = "=SUM(" & .Range(.Cells(lngTmp, intCol), .Cells(lngRow, intCol)).Address & ")"
    intCol = intCol + 1
  Loop
  .Range(.Cells(lngRow + 1, 3), .Cells(lngRow + 1, intCol - 1)).Interior.ColorIndex = 15
End With
End Function


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Summenbildung in Abhängigkeit Abteilungsbezeic
21.12.2005 16:47:17
Bernd
Hallo Sepp,
erst einmal meinen tiefen Dank für deine schnelle Hilft. Das Makro arbeitet auch wunderbar in meiner echten Tabelle, hat leider nur ein Problem:
Da sich bis zum Select-Kriterium "Doppelpunkt" der Abteilungsname vor dem Doppelpunkt durch ergänzende Abteilungs-Gruppen ändert, macht mir das Makro nach jeder Abteilungs-Gruppe eine Summe und nicht erst nach der gesamten Abteilung.
Ich habe eine Alternative: Als Selectkriterium nicht den Doppelpunkt nehmen, sondern die 3. Stelle des Dateinamens in Spalte C (bezogen auf mein eingestelltes Beispiel wäre es die 11. Stelle: "Abteilung A ..."; "Abteilung B ..." etc.).
Wenn Du mir noch mal helfen würdest, wäre ich dir sehr dankbar und eine Einladung zu einer Mass Bier auf dem Oktoberfest sicher.
Grüße
Bernd
Anzeige
AW: Summenbildung in Abhängigkeit Abteilungsbezeic
21.12.2005 17:44:10
Josef Ehrensberger
Hallo Bernd!
Kein Problem!
Wichtig ist nur das Leerzeichen zwischen "Abteilung" und dem Kennzeichen (zB. "A")
und der Doppelpunkt nach dem Kennzeichen!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub ProjekteSpliten()
Dim objWS As Worksheet
Dim lngLast As Long, lngRow As Long, lngTmp As Long
Dim intA As Integer, intB As Integer, intCol As Integer
Dim strTmp As String, strA As String, strB As String


lngRow = 4
lngTmp = lngRow

Set objWS = Sheets("Beispiel") '--> anpassen

With objWS
  
  Do
    
    If .Cells(lngRow + 1, 3) = "" Then
      writeSumm objWS, lngRow, lngTmp, intCol
      Exit Do
    Else
      
      intA = InStr(1, .Cells(lngRow, 3), ":") - 1
      strTmp = Left(.Cells(lngRow, 3), intA)
      intA = InStr(1, StrReverse(strTmp), " ") - 1
      strA = Right(strTmp, intA)
      intA = InStr(1, .Cells(lngRow + 1, 3), ":") - 1
      strTmp = Left(.Cells(lngRow + 1, 3), intA)
      intA = InStr(1, StrReverse(strTmp), " ") - 1
      strB = Right(strTmp, intA)
      
      If strA <> strB Then
        writeSumm objWS, lngRow, lngTmp, intCol
        lngRow = lngRow + 4
        lngTmp = lngRow + 1
      End If
      lngRow = lngRow + 1
    End If
    
  Loop
  
End With

End Sub



Private Function writeSumm(ws As Worksheet, lngRow As Long, lngTmp As Long, intCol As Integer)
With ws
  intCol = 4
  .Rows(lngRow + 1 & ":" & lngRow + 4).Insert
  .Cells(lngRow + 1, 3) = "Summe"
  Do While .Cells(lngRow, intCol) <> ""
    .Cells(lngRow + 1, intCol).Formula = "=SUM(" & .Range(.Cells(lngTmp, intCol), .Cells(lngRow, intCol)).Address & ")"
    intCol = intCol + 1
  Loop
  .Range(.Cells(lngRow + 1, 3), .Cells(lngRow + 1, intCol - 1)).Interior.ColorIndex = 15
End With
End Function


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Summenbildung in Abhängigkeit Abteilungsbezeic
22.12.2005 10:00:12
Bernd
Hi Sepp,
ich habe jetzt mal die konkrete Datei eingestellt und nur etwas anonymsiert.

Die Datei https://www.herber.de/bbs/user/29494.xls wurde aus Datenschutzgründen gelöscht

Leider wird nach wie vor nicht die Abteilungssumme gebildet, sondern die Gruppensumme (Makro kann ich aber trotzdem gut gebrauchen). In dem konkreten Beispiel muesste die Summe nach den Abteilungsbezeichnungen "IT Ltg.", "IT SA" und nach "IT D" gebildet werden.
Wie Du siehst, gibt es ein paar Spalten mehr als in der ersten Beispielmappe. Kannst du das auch berücksichtigen?
Schenkst Du mir noch 'mal Deine Aufmerksamkeit und Deine Zeit, Sepp?
Grüße und Danke vorab.
Bernd
Anzeige
AW: Summenbildung in Abhängigkeit Abteilungsbezeic
22.12.2005 11:11:33
Josef Ehrensberger
Hallo Bernd!
Wenn du gleich die Originaltabelle gesendet hättest, hätten wir
uns das herumprobieren erspart;-))
https://www.herber.de/bbs/user/29499.xls
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Summenbildung in Abhängigkeit Abteilungsbezeic
22.12.2005 12:15:37
Bernd
Hi Sepp,
tausend Dank an Dich. Funktioniert. Musst du eine Ahnung von VBA haben! So schnell so einen komplizierten Code.
Wie kann ich mich dafür bedanken? Das Angebot einer Maß Bier auf dem Oktoberfest steht noch!
Grüße und alles Gute!
Bernd

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige