Excel 2007 VBA Summenbildung

Mr. Snoot · 1. Dezember 2008

Ich hatte bis letzte Woche noch nie was mit Makros zu tun.

Dann gabs in der Arbeit ein Makro das angepasst werden sollte (im Grunde nur paar Zellbereiche editieren), und das hab ich mir halt mal angeschaut. Weil mir aber die ganze Darstellung nicht gefallen hat, wollte ich das ganze noch etwas optimieren (Hervorhebungen, Autofilter um gleich die wichtigen Daten zu haben usw.) und hab mir dann die entsprechenden Befehle ergooglet.

Naja, dann kam eins zum anderen - hier noch bissl was geändert, dort noch mal optimiert. Und schwupps kann man zumindest kleine Makros selbständig schreiben. Bis dahin sind vielleicht 2-3 Stunden vergangen.

Und dann kamst du daher, und ich sah die Chance nochmal zu üben

Das gesamte Makro hier beruht im Grunde ja nur auf Schleifen (tue etwas, solange bis ...) und simplen Zellveränderungen (Farbe ändern, Werte/Formeln einfügen usw.). Recht viel mehr kann ich also auch nicht und meine Lösung ist wie gesagt sicher nicht optimal und hier und da gibts bestimmt auch überflüssige bzw. zu komplizierte Schritte die man eleganter lösen könnte.

randomc[] · 1. Dezember 2008

aber trotzdem ist sehr gut für mich

also ich kann nicht klagen ^^ danke

randomc[] · 2. Dezember 2008

brauche nochmal Hilfe

und zwar muss ich das Makro erweitern.
Also einmal soll aus den gebildeten Summen nochmal eine Summe gebildet werden, also alle Summen sollen zusammengerechnet werden und eine Obersumme ergeben und unter der letzten Zeile ausgegeben werden auch in L.
Desweiteren soll das Makro so laufen, dass wenn ich das Makro starte, dass der die Tabelle kopiert und in Excel einfügt also dass ich dann Tabelle 1 und 2 habe. Also habe zuerst nur 1 Tabelle, dann starte ich das Makro und das Makro kopiert die Tabelle erneut dass ich dann 2x die gleiche Tabelle habe...
Und in Tabelle 1 soll nach Zelle E sortiert werden und in Tabelle 2 nach Zelle O!

Hoffe kannst mir helfen!

Mr. Snoot · 2. Dezember 2008

Ich nehme mal an, dass du die Tabelle aus Tabelle1 in ein zweites Tabellenblatt Tabelle2 (existiert bereits) kopieren willst (Blattnamen ggf. im Code anpassen)!?

Code:

Sub Zeileeinfuegen()

Dim I As Integer
Dim W As Integer
Dim X As Integer
Dim Y As Integer
Dim Z As Integer

I = 1
Y = 7
W = 0

Do While Range("L" & Y) <> ""
Range("L" & Y).Select
  
  If IsEmpty(Range("E" & Y)) Then
    Range("E" & Y).EntireRow.Delete
    Y = Y - 1
  End If
  
  Y = Y + 1
  
Loop
W = WorksheetFunction.Sum(Range("L7:L" & Y))

Worksheets("Tabelle1").Activate
Cells.Select
Selection.Copy

Worksheets("Tabelle2").Activate
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range("A7:W1000").Sort Key1:=Range("O7"), Order1:=xlAscending, Header:=xlNo

Worksheets("Tabelle1").Activate
Range("A7:W1000").Sort Key1:=Range("E7"), Order1:=xlAscending, Header:=xlNo

Do While I <= 2
X = 0
Z = 7

If I = 1 Then
   Worksheets("Tabelle1").Activate
   Spalte = "E"
Else
   Worksheets("Tabelle2").Activate
   Spalte = "O"
End If

Do While Range(Spalte & Z) <> ""
  
  If Range("T" & Z) <> "" Then
    Range("U" & Z) = "=L" & Z
  Else
    Range("U" & Z) = ""
  End If
  
  If Range(Spalte & Z) = Range(Spalte & Z + 1) Then
    Z = Z + 1
  Else
    Range("L" & Z + 1).Select
    Selection.EntireRow.Insert
    Selection.Formula = "=SUM(L" & Z - X & ":L" & Z & ")"
      
    With Range("L" & Z + 1).Font
      .Bold = True
      .ColorIndex = 3
    End With
      
    Z = Z + 2
    X = -1
  End If
    
  X = X + 1
  
Loop

Range("L" & Z) = W
With Range("L" & Z).Font
  .Bold = True
  .ColorIndex = 3
End With

[COLOR="DarkOrange"]With Range("L" & Z).Borders(xlTop)
  .Weight = xlMedium
  .ColorIndex = 1
End With[/COLOR]

Range("A1").Select

[COLOR="Blue"]With ActiveSheet.UsedRange
 .Columns.AutoFit
 .Rows.AutoFit
End With[/COLOR]

I = I + 1
Loop

Worksheets("Tabelle1").Activate

End Sub

Der blau markierte Code am Ende des Makros bewirkt, dass Spaltenbreite und Zeilenhöhe an den Text angepasst werden:

Code:

[COLOR="Blue"]With ActiveSheet.UsedRange
 .Columns.AutoFit
 .Rows.AutoFit
End With[/COLOR]

Falls du das nicht willst, einfach löschen.

Des Weiteren hab ich mal eine Linie über die Gesamtsumme gemacht, damit das etwas abgegrenzt ist:

Code:

[COLOR="darkorange"]With Range("L" & Z).Borders(xlTop)
 .Weight = xlMedium
 .ColorIndex = 1
End With[/COLOR]

randomc[] · 2. Dezember 2008

hm also wenn ich das richtig verstanden habe, existiert das tabellenblatt 2 schon, aber das ist ja nicht so! es gibt ja den punkt "tabelle kopieren und verschieben" dann wird ja die tabelle 1 kopiert und ein 2 tabellenblatt erstellt und das soll per makro geschehen, aber ich teste deins mal. danke

/edit: man muss vorher ein 2.tabellenblatt erstellt haben, aber das soll ja das makro machen und beim ausführen des Makros kommt ein Laufzeitfehler! Laufzeitfehler 6 Überlauf wegen der Zeile
"W = WorksheetFunction.Sum(Range("L7:L" & Y))"

wieso?

//edit2: wenn ich die genannte Zeile lösche läuft es, aber der berechnet keine gesamtsumme, steht nur ein - € :/

Mr. Snoot · 3. Dezember 2008

Also den Fehler kann ich bei mir nicht reproduzieren.

Kannst ja mal schauen, ob die angehängte Exceltabelle läuft: Anhang anzeigen liste.zip

Ich habs jetzt so gemacht, dass, falls Tabelle2 noch nicht exisitiert, diese nach Tabelle1 neu erstellt wird. Andernfalls (Tabelle2 existiert) wird der Inhalt in Tabelle2 mit den Daten aus Tabelle1 überschrieben.

Code:

Sub Zeileeinfuegen()

Dim I, N, M, W, X, Y, Z As Integer
I = 0 '
M = 0 'wird 1 gesetzt wenn Tabelle2 schon existiert
N = 0 'Schleife um zu prüfen ob Tabelle2 existiert
Y = 7 'Zeile ab der die Tabelle beginnt
W = 0 'Gesamtsumme

' Prüfen ob Tabelle2 existiert
For N = 1 To Worksheets.Count
  If Sheets(N).Name = "Tabelle2" Then
  M = 1
  End If
Next

' Tabelle2 erstellen wenn nicht vorhanden
If M = 0 Then
  ActiveWorkbook.Sheets.Add after:=Worksheets("Tabelle1")
  ActiveSheet.Name = "Tabelle2"
End If

Worksheets("Tabelle1").Activate

' Datentabelle zurücksetzen (Summenzeilen löschen)
Do While Range("L" & Y) <> ""
 
  If IsEmpty(Range("E" & Y)) Then
    Range("E" & Y).EntireRow.Delete
    Y = Y - 1
  End If
  
  Y = Y + 1
  
Loop

' Gesamtsumme ermitteln
W = WorksheetFunction.Sum(Range("L7:L" & Y))

' Daten aus Tabelle1 nach Tabelle2 kopieren
Worksheets("Tabelle1").Activate
Cells.Select
Selection.Copy

Worksheets("Tabelle2").Activate
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False

' Tabelle2 nach Spalte O sortieren
Range("A7:W1000").Sort Key1:=Range("O7"), Order1:=xlAscending, Header:=xlNo

' Tabelle1 nach Spalte E sortieren
Worksheets("Tabelle1").Activate
Range("A7:W1000").Sort Key1:=Range("E7"), Order1:=xlAscending, Header:=xlNo

Do While I <= 1
X = 0 ' zum ermitteln wo die jew. Summe beginnt
Z = 7 ' Zeile ab der die Tabelle beginnt

If I = 0 Then
' 1. Durchlauf abarbeiten von Tabelle1
   Worksheets("Tabelle1").Activate
   Spalte = "E"
Else
' 2. Durchlauf abarbeiten von Tabelle2
   Worksheets("Tabelle2").Activate
   Spalte = "O"
End If

Do While Range(Spalte & Z) <> ""
  
  ' prüfen ob ein Wert in Spalte T vorhanden
  If Range("T" & Z) <> "" Then
    Range("U" & Z) = "=L" & Z
  Else
    Range("U" & Z) = ""
  End If
  
  ' prüfen ob Zeilen identischen Wert in Spalte E/O haben
  If Range(Spalte & Z) = Range(Spalte & Z + 1) Then
    Z = Z + 1
  Else
    Range("L" & Z + 1).Select
    Selection.EntireRow.Insert
    Selection.Formula = "=SUM(L" & Z - X & ":L" & Z & ")"
      
    With Range("L" & Z + 1).Font
      .Bold = True
      .ColorIndex = 3
    End With
      
    Z = Z + 2
    X = -1
  End If
    
  X = X + 1
  
Loop

' Gesamtsumme am Ende einfügen
Range("L" & Z) = W
With Range("L" & Z).Font
  .Bold = True
  .ColorIndex = 3
End With

With Range("L" & Z).Borders(xlTop)
.Weight = xlMedium
End With

' Zeilenhöhe/Spaltenbreite anpassen
With ActiveSheet.UsedRange
 .Columns.AutoFit
 .Rows.AutoFit
End With

Range("A1").Select

I = I + 1
Loop

Worksheets("Tabelle1").Activate

End Sub

randomc[] · 3. Dezember 2008

läuft nun ohne fehler

danke vielmals!

randomc[] · 8. Dezember 2008

hab noch nen neues update

also
1. habe ich oben in der tabelle einen tabellenkopf eingefügt und der soll nicht mitsoriert werden, also soll in Zelle A von 1 bis 35 gecheckt werden ob dort "Ordner Nr." steht, wenn es da steht, dann soll ab der nächsten Zeile angefangen werden zu sortieren, also zb. in zelle a32 steht order nr. dann soll ab zelle a33 sortiert werden!
2. wenn in der tabelle in der Zelle A nichts drin steht, dann soll die ganze Zeile gelöscht werden, also zb. in A54 steht nichts drin, dann soll die ganze Zeile 52 gelöscht werden.
3. Formatierungen: Die Schrift soll Arial 10 Pt. sein! und die Tabelle soll die optimale Spaltenbreite haben, also so per makro formatiert werden, dass eine optimale Spaltenbreite da ist, da sonst die Tabelle zu groß werden würde.

Hoffe kannst mir helfen!

Mr. Snoot · 8. Dezember 2008

Das ist jetzt eine komplett andere Tabelle? Häng am besten immer ein Beispiel mit an, dann ist das einfacher

Nach welcher Spalte soll sortiert werden?
"also zb. in A54 steht nichts drin, dann soll die ganze Zeile 52 gelöscht werden" - wohl Zeile 54!?
Soll die Zeile gelöscht werden egal wo sie steht (über/unter deinem Tabellenkopf)?

Hab mal ein Beispiel angehängt:

im Moment würde alles unter Zeile 6 sortiert, derzeit nach Spalte B:
Selection.Sort Key1:=Range("B" & i), Order1:=xlAscending, Header:=xlYes
Jede Zeile, in der die Spalte A leer ist wird gelöscht. Sollen nur Zeilen unterhalb der "Ordner Nr."-Zeile gelöscht werden, entferne das ' in der Zeile Exit For:
' Exit For
Wenn nur die Spalten aber nicht die Zeilen angepasst werden sollen, lösche die komplette Zeile
' .Rows.AutoFit
Anderfalls lösche auch hier das ', dann werden sowohl Spalten als auch Zeilen angepasst

randomc[] · 8. Dezember 2008

ja genau tut mir leid, hab mich verschrieben, meinte wenn in A54 nichts steht soll auch zeile 54 ganz gelöscht werden.

es ist immer noch die ein und dieselbe excel mappe und die gleiche tabelle wie immer

zu meinem punkt 1:
der tabellenkopf soll nicht berührt werden, aber es kann sein dass der Kopf entweder 1 Zeile oder sogar 35 Zeilen einnimmt also von A1 bis A35 und deswegen soll geprüft werden, wo in Zelle A "Order Nr." steht und darunter soll angefangen werden zu sortieren, also in A32 steht Order Nr, ab A33 stehen Namen nach denen soll dann sortiert werden. Im Moment ist das Makro ja so, dass erst ab A7 sortiert werden aber wie gesagt der Kopf kann schon bei A3 oder auch erst bei A35 enden, deswegen muss variabel sortiert werden und daher muss Order Nr. als Anhaltspunkt dienen.

Wenn du es so nicht ganz verstehst, erstelle ich dir gerne nochmal ein Bsp. Habe grad nur wenig Zeit

wie ist das mit der Schrift formatierung ?

Mr. Snoot · 9. Dezember 2008

Im Beispiel wird halt ab Zeile 7 sortiert, weil in Zeile 6 Ordner Nr. steht. Wenn es in Zeile 789 steht, wird ab Zeile 790 sortiert

Schriftformatierung ist auch mit drin:

Code:

With wks.UsedRange
  .Font.Size = 10
  .Font.Name = "Arial"
  .Columns.AutoFit
'  .Rows.AutoFit Zeilen anpassen
End With

Damit wird alles mit Arial 10 formatiert. Oder soll das nur auf die sortierte Tabelle zutreffen?

Ansonsten macht das Makro aber alles so, wie gewünscht - hoffe ich

randomc[] · 9. Dezember 2008

und was wenn order nr in zelle 2 steht wird dann ab 3 sortiert?!

Mr. Snoot · 9. Dezember 2008

Ausprobieren?

Ja

randomc[] · 9. Dezember 2008

ja ok ich werds mal testen und bei problemen mich ggf. nochmal melden

danke

Suche

Excel 2007 VBA Summenbildung

Mr. Snoot

Gast

randomc[]

Cadet 2nd Year

randomc[]

Cadet 2nd Year

Mr. Snoot

Gast

randomc[]

Cadet 2nd Year

Mr. Snoot

Gast

randomc[]

Cadet 2nd Year

randomc[]

Cadet 2nd Year

Mr. Snoot

Gast

Anhänge

randomc[]

Cadet 2nd Year

Mr. Snoot

Gast

Anhänge

randomc[]

Cadet 2nd Year

Mr. Snoot

Gast

randomc[]

Cadet 2nd Year

Ähnliche Themen