Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
740to744
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
740to744
740to744
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Sortieren, addieren usw

Sortieren, addieren usw
11.03.2006 14:45:31
Dietmar
Hallo an alle
Ich habe folgendes Problem, weiß auch nicht ob das überhaupt möglich ist was ich möchte !
Also :
Ich habe ein Tabellenblatt mit verschiedenen Werte. Diese sollten nach Spalte J
aufsteigend sortiert werden. Dann sollten zwei Leerzeilen nach jedem gleichen Wert in Spalte J eingefügt werden und die Werte in B bis F addiert werden. Das Kriterium in Spalte J kann aus einem, zwei oder fünf oder elf oder mehr Werten
bestehend.
Ich habe mal als Beispiel eine Datei geladen.

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

mfg Dietmar

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sortieren, addieren usw
11.03.2006 15:47:37
Reinhard
Hi Dietmar,

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

hat nachfolgenden Code.
Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Option Explicit
Sub tt()
Dim zei As Long, ws As Worksheet, sp As Byte, zeialt As Long
Set ws = Worksheets("Liste")
With Worksheets("Tabelle1")
.UsedRange.ClearContents
ws.UsedRange.Copy Destination:=.Range("A7")
zei = .Range("A65536").End(xlUp).Row
.Range("A9:J" & zei).Sort Key1:=.Range("J9"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
zei = 10
zeialt = 9
While .Range("J" & zei) <> ""
'     MsgBox zei
If .Range("J" & zei) <> .Range("J" & zei - 1) Then
.Range("J" & zei).EntireRow.Insert
.Range("J" & zei).EntireRow.Insert
For sp = 2 To 6
.Cells(zei, sp) = Application.WorksheetFunction.Sum(Range(.Cells(zeialt, sp), .Cells(zei - 1, sp)))
Next sp
zei = zei + 2
zeialt = zei
End If
zei = zei + 1
Wend
For sp = 2 To 6
.Cells(zei, sp) = Application.WorksheetFunction.Sum(Range(.Cells(zeialt, sp), .Cells(zei - 1, sp)))
Next sp
.Activate
End With
End Sub

Anzeige
AW: Sortieren, addieren usw
11.03.2006 18:04:34
Dietmar
Hallo Reinhard
Super - einfach klasse !!! Funktioniert einfach toll !
Jetzt aber noch eine Frage, ohne unverschämt zu erscheinen :
Ist es möglich die so gebildeten Gesamtsummen auf ein weiteres Tabellenblatt
untereinander aufzuführen. Hier sollte aber in Spalte B ab Zelle B20 als erstes
die Angaben Code stehen ??
mfg
Dietmar
AW: Sortieren, addieren usw
11.03.2006 18:25:04
Reinhard
Hi Dietmar,
https://www.herber.de/bbs/user/31813.xls
Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
AW: Sortieren, addieren usw
11.03.2006 18:55:09
Dietmar
Hallo Richard
Das ist klasse - leider habe ich mich vertan! Ich hätte gerne in A10 den Code, Spalte B
bleibt frei und ab Spalte C10 bis G10 sollen wieder die Angaben stehen !
Tut mir leid habe ich letztes Mal übersehen darauf hinzuweisen, ich hoffe dir nicht zuviel
Arbeit zu machen.
sorry
mfg
Dietmar
Anzeige
AW: Sortieren, addieren usw
11.03.2006 21:28:28
Reinhard
Hi Dietmar,
Alt+F11, Doppelklick auf "Modul1", dortigen Code löschen und dies einfügen:
Option Explicit
Sub tt()
Dim zei As Long, ws As Worksheet, sp As Byte, zeialt As Long
Dim ws3 As Worksheet, zei3 As Long
Set ws = Worksheets("Liste")
Set ws3 = Worksheets("Tabelle3")
With Worksheets("Tabelle1")
.UsedRange.ClearContents
ws.UsedRange.Copy Destination:=.Range("A7")
zei = .Range("A65536").End(xlUp).Row
.Range("A9:J" & zei).Sort Key1:=.Range("J9"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
zei = 10
zeialt = 9
zei3 = 10
While .Range("J" & zei) <> ""
'     MsgBox zei
If .Range("J" & zei) <> .Range("J" & zei - 1) Then
.Range("J" & zei).EntireRow.Insert
.Range("J" & zei).EntireRow.Insert
For sp = 2 To 6
.Cells(zei, sp) = Application.WorksheetFunction.Sum(Range(.Cells(zeialt, sp), .Cells(zei - 1, sp)))
Next sp
ws3.Cells(zei3, 1) = .Cells(zei - 1, 10)
Range(.Cells(zei, 2), .Cells(zei, 6)).Copy Destination:=ws3.Cells(zei3, 3)
zei3 = zei3 + 1
zei = zei + 2
zeialt = zei
End If
zei = zei + 1
Wend
For sp = 2 To 6
.Cells(zei, sp) = Application.WorksheetFunction.Sum(Range(.Cells(zeialt, sp), .Cells(zei - 1, sp)))
Next sp
ws3.Cells(zei3, 1) = .Cells(zei - 1, 10)
Range(.Cells(zei, 2), .Cells(zei, 6)).Copy Destination:=ws3.Cells(zei3, 3)
ws3.Activate
End With
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Anzeige
AW: Sortieren, addieren usw
12.03.2006 13:53:35
Dietmar
Hi Reinhard
Danke für deine Antwort. Leider funktioniert etwas nicht, keine Ahnung was, vielleicht
habe ich etwas falsch gemacht oder verstanden. Ich lade dir mal die Datei, ich denke
du weißt sofort was ich falsch gemacht habe !
https://www.herber.de/bbs/user/31829.xls
mfg
Dietmar
AW: Sortieren, addieren usw
12.03.2006 14:05:04
Dietmar
Hi Reinhard
Danke für deine Antwort. Leider funktioniert etwas nicht, keine Ahnung was, vielleicht
habe ich etwas falsch gemacht oder verstanden. Ich lade dir mal die Datei, ich denke
du weißt sofort was ich falsch gemacht habe !
https://www.herber.de/bbs/user/31829.xls
mfg
Dietmar
Anzeige
AW: Sortieren, addieren usw
12.03.2006 15:42:00
Reinhard
Hi Dietmar,
klappt doch alles bestens, wenn du natürlich in "Berechnung" die Zeilen 9 bis 20 ausblendest siehte logo die Ergebnisse nich *gg
Durch
zei3=10
im Code wird festgelegt ab welcher Zeile in Berechnung eingetragen wird, ggfs anpassen.
Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
AW: Sortieren, addieren usw
12.03.2006 15:59:16
Dietmar
Hallo Reinhard
Alles klar - habe mich total verhauen !!
Klappt wie am Schnürchen !!
Vielen Dank
mfg
Dietmar

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige