07.02.2016, 19:58 (Dieser Beitrag wurde zuletzt bearbeitet: 07.02.2016, 20:04 von TedBraun01.)
Hallo Zusammen,
nach dem ich viele Foren durchstöbert habe und auch wirkliche Beiträge darüber gibt, war ich trotzdem nicht fähig mir das Richtige zusammen zu basteln. Es ist inwiefern schwierig, da alle zu 95 % dasselbe wollen, jedoch die Programmierbefehle nur zu 20 % ähneln, ist schwierig dort was zu assoziieren. Ich habe es mal versucht und füge euch die Tabelle mit hinzu.
Momentan habe ich das Gefühl, dass ich jeden Tag 200 Excel-Tabellen pflegen muss und ich möchte das gerne ändern, sonst sehe ich bald nur noch Zeilenrahmen. Ich hoffe ihr könnt mir dabei helfen, dadurch würde ich wirklich viel Zeit und Nerven sparen und es auf andere Tabellen anwenden.
Folgendes:
Ich möchte gerne das auf dem Arbeitsblatt "Auftragsplanung" den Inhalt der Zellen A:J (Zelleninhalt beginnt ab Zelle 6) in den Zellen K6:T6 kopiert wird. Jedoch sollte der Zelleninhalt von A:J auch in das Tabellenblatt "Auswertung" A5:J5 mit verschoben werden, also so gesehen einmal Kopieren und einmal Verschieben.
Der Eintrag der kopiert und verschoben werden soll, soll dann natürlich nicht mehr bei "Auftragsplanung" A:J zusehen sein.
Aber das war noch nicht alles. Die nachstehenden Aufträge sollen automatisch nach oben rutschen und die kopierten bzw. verschobene Aufträge sich automatisch nach unten verschieben (K6:T6 bzw. Tabellenblatt "Auswertung").
Der Auslöser des Programms soll der eingestellte Zelleninhalt in J "abgeschlossen" sein.
Ich hoffe ich habe das gut erklärt. Die Datei schicke mit. Ich hoffe das das überhaupt möglich ist. :s
Ein großes großes Danke schön schon mal an denjenigen der sich dieses Problem widmet.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LngZ1 As Long, lngZ2 As Long
Dim lngZ3 As Long
With Sheets("Auswertung")
lngZ3 = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
On Error GoTo ende
Application.EnableEvents = False
LngZ1 = Cells(Rows.Count, 1).End(xlUp).Row
lngZ2 = Cells(Rows.Count, 11).End(xlUp).Row + 1
If Target.Column = 10 And Target.Row > 5 Then
If Target.Text <> "" Then
If Target.Text = "abgeschlossen" Then
Range(Cells(lngZ2, 11), Cells(lngZ2, 20)) = Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).Value
Sheets("Auswertung").Cells(lngZ3, 1).Resize(, 10) = Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).Value
If Target.Row < LngZ1 Then
Range(Cells(Target.Row, 1), Cells(LngZ1 - 1, 10)) = Range(Cells(Target.Row + 1, 1), Cells(LngZ1, 10)).Value
Range(Cells(LngZ1, 1), Cells(LngZ1, 10)).ClearContents
Else
Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).ClearContents
End If
End If
End If
End If
ende:
Application.EnableEvents = True
If Err Then MsgBox "Fehler: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Sub
07.02.2016, 22:13 (Dieser Beitrag wurde zuletzt bearbeitet: 07.02.2016, 23:01 von Kuwer.)
Hallo Ted,
' **************************************************************
' Modul: Tabelle1 Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************
OptionExplicit
PrivateSub Worksheet_Change(ByVal Target As Range) Dim rngQ As Range With Target.Cells(1) If .Column = 10 And .Row > 5 Then If .Value = "abgeschlossen"Then Set rngQ = .Offset(, -9).Resize(, 9)
rngQ.Copy 'oben einfügen
Me.Range("K6").Insert xlDown 'unten anhängen 'Me.Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
rngQ.Copy 'oben einfügen
Tabelle2.Range("A5").Insert xlDown 'unten anhängen 'Tabelle2.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
rngQ.Resize(, 10).Delete xlUp EndIf EndIf EndWith EndSub
vielen Dank. Beide Programmierung funktionieren einwandfrei. Ein kleine Anmerkung möchte trotzdem zu Uwe noch machen, das ist keine Kritik, weil ich finde ihr beiden habt es voll drauf. Bei Uwes Programmierung geht nach nach dem kopieren in die Zellen K6:T6 meine Formatierung verloren, er zeigt mir dann nur noch die Spalte T grün an, nicht mehr die ganze Zeile von K6:T6.
Atilla? Meinst du du kannst mir nach jeder Zeile eine kleine Erklärung schreiben? Damit ich das vielleicht mal versuchen kann, auf anderen Excel-Tabellen anzuwenden? Das wäre echt klasse. Wie ich sehe habt ihr beide dasselbe erreicht, aber jedoch auf unterschiedlicher Art und Weise. Gibt es im Internet viellleicht ein Programmieranleitung für VBA? Kennt ihr ne gute Seite, wo man die Programmierung lernen kann?
Ich danke euch nochmal von ganzen Herzen. :28: Ihr habt beide ein dickes Lob verdient.
Zitat:Meinst du du kannst mir nach jeder Zeile eine kleine Erklärung schreiben?
ich habe es mal versucht, merke aber, dass das oft mehr Arbeit ist als den Code zu erstellen.
Gute Seiten zum Lernen sind auf jeden Fall Foren, wie z.B. unseres. Ich habe mein Wissen fast ausschließlich aus Foren.
Auch wenn ich so einen Code erstellen kann, ist mein Wissen und Uwes nicht zu vergleichen. Für mich ist das nur ein Hobby
und somit bin ich nur ein Amateur.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LngZ As Long 'Variablendeklaration vom Typ Long,
On Error GoTo ende 'wenn ab hier ein Fehler auftaucht, dann geh zur Sprungmarke "ende"
Application.EnableEvents = False 'Reaktion auf Ereignisse abschalten (würde hier auch ohne funktionieren)
LngZ = Cells(Rows.Count, 1).End(xlUp).Row 'letzte belegte Zelle in Spalte 1 feststellen und an die Variable lngZ übergeben
lngZ2 = Cells(Rows.Count, 11).End(xlUp).Row + 1 'diese Zeile ist überflüssig (Überbleibsel vom anderen Code) (mit Option Explicit als erste Codezeile im Modul wäre sie von Excel moniert worden)
If Target.Column = 10 And Target.Row > 5 Then 'wenn Änderungen in Spalte 10 und Zeilen > 5 stattfinden
If Target.Text <> "" Then 'wenn die tangierte Zelle nicht nicht leer ist (könnte auch wegfallen sehe ich gerade)
If Target.Text = "abgeschlossen" Then 'wenn in der tangierten Zelle "abgeschlossen" steht
Range(Cells(6, 11), Cells(6, 20)).Insert xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'in den Bereich K6:T6 eine Zellen einfügen mit dem Format der darunter liegenden Zellen
Range(Cells(6, 11), Cells(6, 20)) = Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).Value 'in den Bereich K6:T6 den Inhalt aus dem Bereich A:J der tangierten Zeile schreiben
Sheets("Auswertung").Cells(5, 1).Resize(, 10).Insert xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'in Tabelle "Auswertung in den Bereich A5:J5 eine Zellen einfügen mit dem Format der darunter liegenden Zellen
Sheets("Auswertung").Cells(5, 1).Resize(, 10) = Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).Value 'in Tabelle "Auswertung" in den Bereich A5:J5 den Inhalt aus dem Bereich A:J der tangierten Zeile schreiben
If Target.Row < LngZ Then 'wenn Zeilenzahl der tangierten Zelle kleiner als die Zahl ist, die in der Variablen lngZ abgelegt ist dann
' den Bereich A:J der tangierten Zeile bis eine Zeile vor der Letzten, überschreiben mit dem Bereich eine Zeile tiefer der tangierten Zeile bis zur letzten Zeile
Range(Cells(Target.Row, 1), Cells(LngZ - 1, 10)) = Range(Cells(Target.Row + 1, 1), Cells(LngZ, 10)).Value
Range(Cells(LngZ, 1), Cells(LngZ, 10)).ClearContents 'den Inhalt der letzten Zeile leeren, da doppelt
Else 'sonst (die tangierte Zeile ist die letzte Zeile)
Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).ClearContents 'Inhalt im Bereich A:J der tangierten Zeile löschen
End If
End If
End If
End If
'ab hier wird der Code immer ausgeführt, während er oben je nach Bedingung verzweigt und nicht ausgeführt werden kann
'Bei Fehlern währen der Codeausführung im obigen Teil wird sofort hierhin gesprungen und der Code hier weitergeführt
ende:
Application.EnableEvents = True 'deswegen wird hier die Reaktion auf Ereignisse wieder eingeschaltet
If Err Then MsgBox "Fehler: " & Err.Number & vbCrLf & vbCrLf & Err.Description 'wenn ein Fehler aufgetreten ist, dann Meldung mit Fehlernummer und Beschreibung
End Sub
Vielen Dank für die Erklärungen, das bringt viel Licht ins Dunkle. Wenn das so erklärt ist wie im dem Fall von dir, dann ist der lernfktor sehr groß. Aber oft stehen nur sehr wenige Erklärungen dabei und das ist sehr schwierig , etwas zu lernen.
Aber so wie du es gemacht hast ist das Einwandfrei.
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
Wie ich sehe habt ihr beide dasselbe erreicht, aber jedoch auf unterschiedlicher Art und Weise. Gibt es im Internet viellleicht ein Programmieranleitung für VBA? Kennt ihr ne gute Seite, wo man die Programmierung lernen kann?