teilausgefüllte Zeilen eín- und ausblenden

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'Makro unter dem Tabellenblatt mit den Eingaben Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 5 Then 'Spalte E If Target.Row > 1 Then If Application.WorksheetFunction.CountA(Range(Cells(Target.Row, 1), _ Cells(Target.Row, 6))) = 1 Then 'Neue Zeile mit Paletten-Nummer löschen If Target.Offset(-1, 0).Value = Target.Value Then Target.EntireRow.Delete End If Cancel = True Else 'Leerzeile mit Palettennummer einfügen Target.Offset(1, 0).EntireRow.Insert Target.Offset(1, 0).Value = Target.Value Cancel = True End If End If End If End Sub

'Makro unter dem Tabellenblatt mit den Eingaben Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 5 Then 'Spalte E If Target.Row > 1 Then Application.EnableEvents = False If Target.Offset(-1, 0).Value = Target.Value Then If Application.WorksheetFunction.CountA(Range(Cells(Target.Row, 1), _ Cells(Target.Row, 6))) = 1 Then 'Neue Zeile mit Paletten-Nummer löschen Target.EntireRow.Delete Else If MsgBox("Zeile " & Target.Row & " löschen?", _ vbQuestion + vbOKCancel + vbDefaultButton2, _ "Zeile löschen") = vbOK Then 'Zeile mit Inhalten löschen Target.EntireRow.Delete End If End If Cancel = True ElseIf Target.Offset(-1, 0).Value Target.Value Then 'Leerzeile mit Palettennummer einfügen Target.Offset(1, 0).EntireRow.Insert Target.Offset(1, 0).Value = Target.Value Cancel = True End If Application.EnableEvents = True End If End If End Sub

Hallo Franz,
vielen vielen Dank für die Hilfe! Einfach super! Und das zum Sonntag! Hut ab!!
Wie du vielleicht denken kannst, kommt man dann immer auf neue Ideen, um es einfach so perfekt wie möglich zu machen.....
Nämlich:
in Spalte B ist ein Sverweis:
=WENN(ISTNV(SVERWEIS(A2;Tabelle3!A:B;2;FALSCH));"";(SVERWEIS(A2;Tabelle3!A:B;2;FALSCH)))
wenn ich nun die erste Zelle einer Palettennummer zum Erstellen einer neuen Zeile doppelklicke, müsste dieser SVerweis automatisch in jeder neu erstellten Zeile von alleine auftauchen. Geht das?
Als nächstes:
Das Doppelklicken aller weiterer Palettennummern außer der obersten zum Löschen ist perfekt!
Wäre es möglich, durch Doppelklicken der Spalte A vorher den Inhalt der Zeile außer Spalte E (Palettennummer) zu löschen, mit Sicherheitsabfrage? Das Löschen der gesamten Zeile wie du es eingestellt hast, kann so bleiben!
Dann hätte ich gerne noch in Spalte H die Summe aller Zellen aus Spalten C und D, in denen sich in Spalte E die gleiche Palettennummer befindet.
Sozusagen sehe ich in der obersten Zeile einer Palettennumemr, wieviel Kartons sich insgesamt auf der Palette (zB 1) befinden. Egal, ob sich nur 1 oder 3 oder 7 (verschiedene Zeilen bzw) Artikel auf der Palette befinden.
Müsste sich natürlich auch von alleine erweitern, wenn neue Zeilen mit einer Palettennummer hinzugefügt werden.
Danke im Voraus!!! :-)

Hallo Holm,
das Makro entwickelt sich langsam zu einem Roman.
Formel in H2 zur Berechnung der Anzahl Verpackungen:

=WENN(BEREICH.VERSCHIEBEN(E2;-1;0)=E2;"";SUMMENPRODUKT((E2=$E$2:$E$149)*$C$2:$D$149))

Die 149 in der Formel musst du entsprechend der Zeilenzahl in deiner Liste anpassen. Diese Formel dann in Spalte H kopieren.
Denke auch daran, das du im Worksheet_Change-Makro die Nummer der Spalte anpassen musst, in die Datum-Zeit eingetragen werden.
Gruß
Franz

'Makro unter dem Tabellenblatt mit den Eingaben
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Zeile As Long
Dim Statuscalc As Long
Select Case Target.Column
Case 1  'Spalte A
If MsgBox("In Zeile " & Target.Row & " Werte außer Paletten-Nr. löschen?", _
vbQuestion + vbOKCancel + vbDefaultButton2, _
"Inhalte in Zeile löschen") = vbOK Then
'Makrobremsen lösen
With Application
.EnableEvents = False
Statuscalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'In Zellen mit Werten außer Palletten-Nr. den Inhalt löschen
With Cells(Target.Row, 1)
.Offset(0, 0).ClearContents
.Offset(0, 2).ClearContents
.Offset(0, 3).ClearContents
.Offset(0, 5).ClearContents
.Offset(0, 6).ClearContents
.Offset(0, 8).ClearContents
End With
'Makrobremsen zurücksetzen
With Application
.EnableEvents = True
.Calculation = Statuscalc
.ScreenUpdating = True
End With
Cancel = False
End If
Case 5  'Spalte E
If Target.Row > 1 Then
'Makrobremsen lösen
With Application
.EnableEvents = False
Statuscalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
If Target.Offset(-1, 0).Value = Target.Value Then
'Prüfen, ob außer Paletten-Nr. und Formeln ander Zellen ausgefüllt sind
If Application.WorksheetFunction.CountA(Range(Cells(Target.Row, 1), _
Cells(Target.Row, 6))) = 2 Then
'Neue Zeile mit Paletten-Nummer löschen
Target.EntireRow.Delete
Else
If MsgBox("Zeile " & Target.Row & " löschen?", _
vbQuestion + vbOKCancel + vbDefaultButton2, _
"Zeile löschen") = vbOK Then
'Zeile mit Inhalten löschen
Target.EntireRow.Delete
End If
End If
Cancel = True
ElseIf Target.Offset(-1, 0).Value  Target.Value Then
'Leerzeile mit Palettennummer einfügen
Target.Offset(1, 0).EntireRow.Insert
Target.Offset(1, 0).Value = Target.Value
'Formel in Spalte B kopierem
Cells(Target.Row, 2).Copy Cells(Target.Row + 1, 2)
'Formel in Spalte H kopieren/neu erstellen
Zeile = Target.Row
If Zeile + 1 = Cells(Rows.Count, 2).End(xlUp).Row Then
'Neuer Eintrag am Ende der Liste - alle Formeln in H ab Zeile 2 neu erstellen
Range(Cells(2, 8), Cells(Zeile + 1, 8)).FormulaR1C1 = _
"=IF(OFFSET(RC[-3],-1,0)=RC[-3],"""",SUMPRODUCT((RC[-3]=R2C5:R" _
& Zeile + 1 & "C5)*R2C3:R" & Zeile + 1 & "C4))"
Else
'Formel in Spalte H kopieren
Cells(Zeile, 8).Copy Cells(Zeile + 1, 8)
End If
Cancel = True
End If
'Makrobremsen zurücksetzen
With Application
.EnableEvents = True
.Calculation = Statuscalc
.ScreenUpdating = True
End With
End If
End Select
End Sub

Beliebteste Forumthreads (12 Monate)

teilausgefüllte Zeilen eín- und ausblenden

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

teilausgefüllte Zeilen eín- und ausblenden

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread