Werte an Wochenenden o. rote Bereiche überspringen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Ibo,

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


Sub Zeilen_verschieben_nach_oben()
Dim lngNext As Long, varTemp As Variant
'verschieb die Zelleninhalte der markierten Zeile/ Zelle nach oben ; ab SpalteC bis J
With ActiveCell
  If .Row > 1 Then
    For lngNext = .Row - 1 To 1 Step -1
      If Cells(lngNext, 1).DisplayFormat.Interior.Color <> RGB(255, 0, 0) Then Exit For
    Next
    varTemp = Intersect(.EntireRow, Range("C:J"))
    Intersect(.EntireRow, Range("C:J")) = Intersect(Rows(lngNext), Range("C:J")).Value
    Intersect(Rows(lngNext), Range("C:J")) = varTemp
    Intersect(Rows(lngNext), Range("C:J")).Select
  Else
    MsgBox "noch oben zu verschieben ist nicht möglich" & vbLf & "die erste Zeile wurde bereits erreicht"
  End If
End With
End Sub


Sub Zeilen_verschieben_nach_unten()
Dim lngNext As Long, varTemp As Variant
'verschieb die Zelleninhalte der markierten Zeile/ Zelle nach unten ; ab SpalteC bis J
With ActiveCell
  If .Row < Rows.Count Then
    For lngNext = .Row + 1 To Rows.Count
      If Cells(lngNext, 1).DisplayFormat.Interior.Color <> RGB(255, 0, 0) Then Exit For
    Next
    varTemp = Intersect(.EntireRow, Range("C:J"))
    Intersect(.EntireRow, Range("C:J")) = Intersect(Rows(lngNext), Range("C:J")).Value
    Intersect(Rows(lngNext), Range("C:J")) = varTemp
    Intersect(Rows(lngNext), Range("C:J")).Select
  Else
    MsgBox "noch oben zu verschieben ist nicht möglich" & vbLf & "die erste Zeile wurde bereits erreicht"
  End If
End With
End Sub

Gruß Sepp

Hallo ibo,
ich melde mich noch mal mit meinem überarbeiteten Lösungsvorschlag. Den Fehler mit dem Anhängen von Modulen habe ich behoben. Ich habe die Personen auf Motorräder umgestellt und zwei weitere Funktionen eingebaut: Beginn der Tabelle 1 individuell einstellen und Einfügen einer zusätzlichen Zeile.
Hier die für den Echt-Betrieb zu nutzende Originaldatei.
https://www.herber.de/bbs/user/118767.xlsm
Ausführliche Tests habe ich mit der neuen Version durchgeführt, die nunmehr einwandfrei arbeiten müsste. Falls doch noch Fehler auftreten sollten, bitte melden. Hier meine Testdatei.
https://www.herber.de/bbs/user/118768.xlsm
Auch die Hinweise zur Bedienung des Programms wurden überarbeitet
https://www.herber.de/bbs/user/118769.xlsm
Du kannst in das Programm alle 8 in Bearbeitung befindlichen Motorräder führen - was ich für die richtige Lösung halte - oder, wenn Du unbedingt willst, mit dem Motorrad, dass neu in die Montagestation 1 beginnt, anfangen; anschließend den nächsten Neuzugang einstellen usw.
Bitte nochmal ausprobieren.
Mit freundlichem Gruß
Peter Kloßek

Beliebteste Forumthreads (12 Monate)

Werte an Wochenenden o. rote Bereiche überspringen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte an Wochenenden o. rote Bereiche überspringen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread