Office: (Office 2010) Bereich mit Hilfe eines Dropdowns+Button löschen (VBA)

scratrat · 3. März 2020

Moin, Forum!

Ich hab da mal wieder ne Frage...

Ich habe eine Arbeitsmappe, in der eine Liste ist (siehe Spalte A,B in der angehängten Datei). Diese Liste beinhaltet in Spalte A ne Auftrags-Nr. und in der Spalte B in der gleichen Zeile den Kundennamen und in den folgenden Zeilen darunter Aufgaben zum entsprechenden Auftrag (Text1 bis...).

Ich möchte nun anhand eines Dropdownmenüs (Zelle E4) eine Auftragsnr. auswählen und per Button (Dieser befindet sich noch nicht in der Arbeitsmappe) den entsprechenden Auftrag samt den darunterliegenden Aufgaben aus der Liste herauslöschen (Nur die ZELLINHALTE). Anschließend sollen die nachfolgenden Aufträge um die gelöschten Zell-INHALTE nach oben verschoben werden.

Das ganze soll in VBA als Makro fungieren, welches dann per Buttonklick ausgelöst wird.

Kann mir da jemand helfen??

Vielen Dank im Voraus,
Andreas

:)

Beverly · 5. März 2020

Hi,

z.B. so:

Code:

Sub Loeschen()
Dim rngSuche As Range
Dim lngEnde As Long
Set rngSuche = Columns(1).Find(Range("E4"), lookat:=xlWhole)
If Not rngSuche Is Nothing Then
lngEnde = rngSuche.Row
Do
lngEnde = lngEnde + 1
If Cells(lngEnde, 1) "" Then Exit Do
Loop While Cells(lngEnde, 2) ""
Range(rngSuche.Address, rngSuche.Offset(lngEnde - rngSuche.Row - 1, 1)).Delete shift:=xlUp
Else
MsgBox "Nr. " & Range("E4") & " nicht gefunden"
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Beachte aber, dass nach dem löschen der Zellen deine Liste in Spalte I nicht mehr stimmt. Du solltest sie nicht per Formeln sondern per VBA generieren.

scratrat · 5. März 2020

Danke, das klappt schonmal sehr gut!

Ich habe neulich das gleiche Problem gehabt, dass die Formelliste durch den Löschbefehl in dem VBA-Code nicht mehr funktionierte.
Ich habe dann den Copy/Destinationbefehl verwendet und die Zellinhalte einfach verschoben. Dann funzte das auch wieder mit der Liste.

In meiner richtigen Arbeitsmappe folgen nach der Auftragsnr. ja die Aufgabentexte und die Spalten, nach den Aufgaben, beinhalten Werte, die Spaltenweise (praktisch pro Tag) im oberen Bereich des Datenblattest per Formel erfasst werden. Ich schätze, dass auch diese Formeln dann nicht mehr funktionieren, oder?

Zum besseren Verständnis habe ich mal das Originialdokument beigefügt.

Im oberen Bereich (Grün hinterlegt) sind SummeWenn-Formeln, die - je nach Datum - die Spaltenwerte prüfen und per Bedingte Formatierung diese Werte dann farblich wiedergeben.
Beim Öffnen der Datei wird zudem geprüft, of es immernoch das in Zelle A4 hinterlegte Datum =heute() ist. Ist dies nicht der Fall, so wird der gesamte Bereich neben den Aufträgen um eine Zelle nach links verschoben (mit Copy-Destination). Danach funktionieren auch weiterhin die Formeln.

Ist es ggf. möglich, die Formel so umzuändern, dass der "hochrutschende" Teil der Auftragsliste per Copy-Destination verschoben wird? Das würde dann den Bereich von Spalte A bis Spalte AY betreffen.

Das wäre sehr geil!

Danke im Vorraus!
Andreas

Beverly · 5. März 2020

Wenn du die ganze Zeile löschst, dann gibt es mit deiner Formel kein Problem. Wenn du allerdings tatsächlich nur in einigen Spalten die Zellen löschen willst (was ich allerdings bei einer Zeilenbezogenen Auflistung wie in deiner Mappe als nicht sehr sinnvoll erachte), dann kannst du es mit der folgenden Formel in C1 (dann nach unten ziehen) versuchen: {=WENN(ZEILE(A5)>ANZAHL2(Projekte!A:A);"";INDEX(Projekte!A:A;KKLEINSTE(WENN(Projekte!A$1:A$2995"";ZEILE($1:$1000));ZEILE(A5))))}
Beachte die geänderten Zeilenangaben!

scratrat · 6. März 2020

Danke dafür!

Okay, ich werde das austesten.

Und die Angabe, um die ganze Zeile zu löschen, finde ich in welcher Anweisung in Deinem VBA-Script?

Danke im Vorraus,
Andreas

Beverly · 6. März 2020

In dieser Zeile

Code:

Range(rngSuche.Address, rngSuche.Offset(lngEnde - rngSuche.Row - 1, 1)).Delete shift:=xlUp
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ist der Bereich der Zeilen angegeben, innerhalb dessen die Zellen nur in den Spalten A:B gelöscht werden.
Sollen es dagegen die gesamten Zeilen sein, dann erreicht man dies, indem man einfach .EntireRow (=gesamte Zeile) ergänzt:

Code:

Range(rngSuche.Address, rngSuche.Offset(lngEnde - rngSuche.Row - 1, 1)).EntireRow.Delete shift:=xlUp
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

scratrat · 8. März 2020

Perfekt! Danke, das probiere ich gleich aus!

scratrat · 8. März 2020

Hervorragend! Klappt Super! Danke!

Nun hab ich da noch eine, hoffentlich, kleine Frage:
Ich würde gern die Felder der ATNr., des Kunden und des Liefertermins auf der Projektseite auslesen und auf einem Tabellenblatt "Archiv" eintragen lassen.

Ich habe den VBA-Code folgendermaßen umgeschrieben (Nach meinen Fähigkeiten *grins*), aber irgendwie funzt das noch nicht so wirklich...

Code:

Sub AuftragLoeschen()
Dim KDArchiv As String, ATArchiv As String, VSArchiv As String, NZ As Integer

Dim rngSuche As Range
Dim lngEnde As Long
Worksheets("Projekte").Select
ATArchiv = Range("BD3")

Set rngSuche = Columns(1).Find(Range("BD3"), lookat:=xlWhole)
KDArchiv = Cells(rngSuche.Row, 2)
VSArchiv = Cells(rngSuche.Row, 4)

Set rngSuche = Columns(1).Find(Range("BD3"), lookat:=xlWhole)
If Not rngSuche Is Nothing Then
lngEnde = rngSuche.Row
Do
lngEnde = lngEnde + 1
If Cells(lngEnde, 1) "" Then Exit Do
Loop While Cells(lngEnde, 2) ""
Range(rngSuche.Address, rngSuche.Offset(lngEnde - rngSuche.Row - 1, 1)).EntireRow.Delete shift:=xlUp
Else
MsgBox "Nr. " & Range("BD3") & " nicht gefunden"
End If

Worksheets("Archiv").Select
NZ = Range("a1")
ActiveCell(0, 0).Select
ActiveCell.Offset(NZ + 1, 0).Value = ATArchiv
ActiveCell.Offset(0, 1).Value = KDArchiv
ActiveCell.Offset(0, 1).Value = VSArchiv
Worksheets("Projekte").Select
ActiveCell(18, 1).Select

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Code liest zwar das Lieferdatum aus, jedoch nicht den Kunden.
Und beim Eintragen auf der Archivseite trägt er das irgendwo auf der Seite ein...

Archiv-Blatt:
Zelle A1 = Anzahl2(A3:A100)
Zelle A2 = "AT"
Zelle B2 = "Kunde&Projekt"
Zelle C2 = "LT"

Was hab ich da verkehrt gemacht??

Liebe Grüße,
Andreas

Beverly · 8. März 2020

Wenn ich dein Anliegen richtig verstanden habe dann so:

Code:

Sub AuftragLoeschen()
Dim rngSuche As Range
Dim lngEnde As Long
Dim lngZiel As Long
With Worksheets("Archiv")
lngZiel = .Columns(1).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
End With
With Worksheets("Projekte")
Set rngSuche = Columns(1).Find(.Range("BD3"), lookat:=xlWhole)
If Not rngSuche Is Nothing Then
lngEnde = rngSuche.Row
Do
lngEnde = lngEnde + 1
If .Cells(lngEnde, 1) "" Then Exit Do
Loop While .Cells(lngEnde, 2) ""
Union(rngSuche, rngSuche.Offset(0, 1), rngSuche.Offset(0, 3)).Copy Worksheets("Archiv").Cells(lngZiel, 1)
.Range(rngSuche.Address, rngSuche.Offset(lngEnde - rngSuche.Row - 1, 1)).EntireRow.Delete shift:=xlUp
Else
MsgBox "Nr. " & Range("BD3") & " nicht gefunden"
End If
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

scratrat · 8. März 2020

Perfekt! Danke! Genauso!

Inzwischen ist hier bei uns im Büro noch eine weitere Frage aufgekommen:
Kann man die Aufgaben in der Projekt-Tabelle automatisch Gruppieren, sodass
man links mit Hilfe des + und - Zeichens (die ja bei Gruppen automatisch entstehen)
die Aufgaben ein- und ausblenden kann und nur noch die Projekte alleine dastehen?

Ich muss mich schonmal für die bröckchenweisen Fragen bei Dir entschuldigen und Dir von allen hier
ein riesiges Dankeschön aussprechen!

Liebe Grüße,
Andreas

Beverly · 8. März 2020

Guppieren könntest du auf diesem Weg:

Code:

Sub Gruppieren()
Dim rngBereich As Range
Dim lngStart As Long
Dim lngLetzte As Long
Dim lngZeile As Long
Dim intOutline As Integer
Application.ScreenUpdating = False
With Worksheets("Projekte")
intOutline = .Outline.SummaryRow
lngLetzte = .Columns(2).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range(.Cells(15, 1), .Cells(lngLetzte, 1)).ClearOutline
.Outline.SummaryRow = xlAbove
lngStart = 17
For lngZeile = 18 To lngLetzte
If lngZeile = lngLetzte Then
Set rngBereich = .Range(.Cells(lngStart + 1, 1), .Cells(lngLetzte, 1))
rngBereich.EntireRow.Group
End If
If .Cells(lngZeile, 1) "" Then
Set rngBereich = .Range(.Cells(lngStart + 1, 1), .Cells(lngZeile - 1, 1))
rngBereich.EntireRow.Group
lngStart = lngZeile
End If
DoEvents
Next lngZeile
.Outline.SummaryRow = intOutline
End With
Application.ScreenUpdating = True
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

scratrat · 9. März 2020

Sehr sehr geil!!!

Vielen, vielen Dank, Karin, für die supertolle Unterstützung!
Das sollte es erstmal gewesen sein!

Liebe Grüße,
Andreas

Office: (Office 2010) Bereich mit Hilfe eines Dropdowns+Button löschen (VBA)

Bereich mit Hilfe eines Dropdowns+Button löschen (VBA)

Bereich mit Hilfe eines Dropdowns+Button löschen (VBA)

Bereich mit Hilfe eines Dropdowns+Button löschen (VBA)

Bereich mit Hilfe eines Dropdowns+Button löschen (VBA)

Bereich mit Hilfe eines Dropdowns+Button löschen (VBA) - Similar Threads - Bereich Hilfe Dropdowns+Button

Bereich von Excel nach Word mit zusammenhängenden Passagen übergeben

Nur markierte Zellen kopieren und wieder einfügen

Bereich zweimal in Word einfügen (VBA)

Bereich (z.B. C1:C12) aus Formel berechnen lassen

Word geschützter Bereich in Tabelle

Urlaubsplan mit aktuellen Stand der einzelnen Bereiche

Brauche Hilfe bei der Zuweisung von Bereichen(z.B81-100%= 4)