Wenn Dann gleich sortieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
Unsortiert ohne Leerzeilen krieg ich hin:
Tabelle1

	A	B	C	D	E	F	G	H
1		1
2					Anzahl	Artikel	Gesamtpreis	Einzelpreis
3	1	Halbes Hähnchen	3,00	0,00		Hähnchenschlegel	1,6	3,2
4	2	Hähnchenschlegel	1,60	3,20	2	Putenpartyschnitzel im Semmel	2,2	11
5	3	Schnitzel	3,20	0,00		Lamm-Haxen	4,2	8,4
6	4	Partyschnitzel	1,60	0,00		Weißwürste - nur Freitags	1,7	15,3
7	5	Partyschnitzel im Semmel	2,00	0,00		Käsespätzla	3,5	7
8	6	Putenschnitzel	3,50	0,00		Kartoffelsalat	1,5	3
9	7	Putenpartyschnitzel	1,80	0,00		Karottenkrautsalat	1,6	3,2
10	8	Putenpartyschnitzel im Semmel	2,20	11,00	5	Lumpensalat	2,8	5,6
11	9	Cordon bleu	3,80	0,00		Kesselfleisch mager	1,7	3,4
12	10	Fleischsemmel	1,60	0,00		#ZAHL!	#ZAHL!	#ZAHL!
13	11	Fleischküchle	1,30	0,00		#ZAHL!	#ZAHL!	#ZAHL!
14	12	Fleischküchle im Semmel	1,60	0,00		#ZAHL!	#ZAHL!	#ZAHL!
15	13	Schweins-Haxen	3,20	0,00		#ZAHL!	#ZAHL!	#ZAHL!
16	14	Lamm-Haxen	4,20	8,40	2
17	15	Mini-Haxen	2,00	0,00
18	16	Schälrippchen	2,70	0,00
19	17	Gegrillter Bauch	1,70	0,00
20	18	Leberkäase	1,50	0,00
21	19	LKW	1,40	0,00
22	20	Weißwürste - nur Freitags	1,70	15,30	9
23	21	Bauernwürste	1,70	0,00
24	22	Paprikawürste	1,70	0,00
25	23	Saitenwürste	1,70	0,00
26	24	Käsespätzla	3,50	7,00	2
27	25	Portion Spätzla	2,30	0,00
28	26	Pommes	1,50	0,00
29	27	Kroketten	1,50	0,00
30	28	Wedges	1,50	0,00
31	29	Soße extra	0,30	0,00
32	30	Ketchup	0,20	0,00
33	31	Kartoffelsalat	1,50	3,00	2
34	32	Gem. Salat	3,00	0,00
35	33	Grüner Salat	1,30	0,00
36	34	Karottenkrautsalat	1,60	3,20	2
37	35	Nudelsalat	1,60	0,00
38	36	Wurstsalat	2,80	0,00
39	37	Schweizer-Wurstsalat	2,80	0,00
40	38	Lumpensalat	2,80	5,60	2
41	39	Puten-Wurstsalat	2,80	0,00
42	40	Kesselfleisch normal	1,70	0,00
43	41	Kesselfleisch mager	1,70	3,40	2
44	42	Knöchle Stck.	1,20	0,00
45	43	Bier	1,20	0,00
46	44	Bild Zeitung	0,90	0,00
47			Gesamt:	60,10	28		60,10

Formeln der Tabelle

Zelle	Formel
F3	{=INDEX($B$3:$D$46;KKLEINSTE(WENN($E$3:$E$46<>"";ZEILE($A$1:$A$43)); ZEILE(A1)); SPALTE(A1))}

Enthält Matrixformel:
Umrandende { } nicht miteingeben,
sondern Formel mit STRG+SHIFT+RETURN abschließen!

Matrix verstehen

Bedingte Formatierungen der Tabelle

Zelle

Nr.: / Bedingung

Format

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
ransi

Hallo
mit 2 Änderungen ginge es
- Die Formeln in F bitte das " " (mit Leerzeichen) ändern in "" (ohne Leerzeichen)
- in der Summenzeile in Spalte F XXXXX eintragen (Steht dann beim Sortieren ganz unten)
Dann
- Rechtsclick auf den Tabellenblattreiter
- Code anzeigen
- Diesen Code dort reinkopieren
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim LZ As Integer On Error GoTo Fehler If Not Intersect(Range("E:E"), Target) Is Nothing Then If Target.Row > 2 Then If Target.Count = 1 Then Application.EnableEvents = False Columns("K:N").Value = Columns("E:H").Value With Me.Sort .SortFields.Clear .SortFields.Add Key:=Range( _ "L:L"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal .SetRange Columns("K:N") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("K1:N1").Insert xlDown LZ = WorksheetFunction.Match("XXXXX", Columns("L")) Range("L" & LZ).ClearContents Else MsgBox "Bitte einzeln bearbeiten" End If End If End If Err.Clear Fehler: Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Fehler: " & _ Err.Number & vbLf & Err.Description: Err.Clear End Sub
Bei jeder Änderung in E wird kopiert und sortiert
Gruß UweD
Über Rückmeldungen würde ich mich freuen

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim LZ As Integer, TMP As String On Error GoTo Fehler If Not Intersect(Range("E:E"), Target) Is Nothing Then If Target.Row > 2 Then If Target.Count = 1 Then TMP = "XXXXX" Application.EnableEvents = False LZ = Cells(Rows.Count, "E").End(xlUp).Row Range("K2:N" & LZ).Value = Range("E2:H" & LZ).Value Range("L" & LZ) = TMP With Me.Sort .SortFields.Clear .SortFields.Add Key:=Range( _ "L:L"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal .SetRange Range("K2:N" & LZ) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With LZ = WorksheetFunction.Match(TMP, Columns("L")) Range("L" & LZ).ClearContents Else MsgBox "Bitte einzeln bearbeiten" End If End If End If Err.Clear Fehler: Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Fehler: " & _ Err.Number & vbLf & Err.Description: Err.Clear End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread