Spalten und zellen Schleife?

[kaptan2002]

Hallo,
siehe bitte im Anhang eine Beispiel Tabelle an.
möchte mein Wochenplan erleichtern.Ist das möglich mit Button?

z.B. diese Woche
Blaue Gruppe 1 mit den Uhren haben Frühschicht Artikel Angebot 1 bis Angebot 25.
Grüne Gruppe 2 mit den Fotos haben Spätschicht Artikel Angebot 26 bis Angebot 50.
Orange Gruppe 3 mit den Handy haben Nachtschicht Artikel Angebot 51 bis Angebot 75.

nächste Woche:
hat Gruppe 1 Nachtschicht
Gruppe 2 Frühschicht
Gruppe 3 Spätschicht

jede Woche im wechsel also Gruppen Rhythmus ist immer Frühschicht Nachtschicht Spätschicht.

kann ich das auf drücken einer Button ermöglichen?

also A1 bis A29 (früh) zu C1 bis C29 (Nacht)
C1 bis C29 (Nacht) zu B1 bis B29 (Spät)
B1 bis B29 (Spät) zu A1 bis A29 (Früh)

jede Woche in dieser Schleife



hoffe das ich das einigermaßen erklärt zu haben.


mfg
kaptan

[atilla]

Hallo Kaptan,

das geht auch per Formel, wenn bestimmte Vorgaben erfüllt sind.

Du hast Deine Daten in anderen Spalten fest eingegeben:

Arbeitsblatt mit dem Namen 'Tabelle1'
	F	G	H
1	Gruppe 1	Gruppe 2	Gruppe 3
2	Uhren	Fotos	Handy
3
4	Angebot 1	Angebot 26	Angebot 51
5	Angebot 2	Angebot 27	Angebot 52

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

Dann werden sie wöchentlich so per Formel automatisch angepast:

Arbeitsblatt mit dem Namen 'Tabelle1'
	A	B	C
1	Früh	Spät	Nacht
2	Gruppe 3	Gruppe 1	Gruppe 2
3	Handy	Uhren	Fotos
4
5	Angebot 51	Angebot 1	Angebot 26
6	Angebot 52	Angebot 2	Angebot 27

Zelle	Formel
A2	=INDEX($F$1:$H$1;;REST(HEUTE()+SPALTE(C1)*7+2-REST(HEUTE();7);3)+1)
A3	=INDEX($F$2:$H$2;;REST(HEUTE()+SPALTE(C2)*7+2-REST(HEUTE();7);3)+1)
A5	=INDEX($F$4:$H$28;ZEILE(A1);REST(HEUTE()+SPALTE(C1)*7+2-REST(HEUTE();7);3)+1)

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

[kaptan2002]

Hallo atilla ,
vielen Dank für deine Formel
aber so ist es mir ehrlich gesagt zu kompliziert.Möchte es einfach auf Button klick alles aufgerückt haben.

Gruß
kaptan

[atilla]

Hallo Kaptan,

Dann teste mal folgenden Code:

Code ins Code Modul der Tabelle einfügen.

Code:

Option Explicit

'also A1 bis A29 (früh) zu C1 bis C29 (Nacht)
'C1 bis C29 (Nacht) zu B1 bis B29 (Spät)
'B1 bis B29 (Spät) zu A1 bis A29 (Früh)
Sub verschieben()
   Dim vntA As Variant
   Dim vntB As Variant
   Dim vntC As Variant
  
   vntA = Range("A1:A29").Value
   vntB = Range("B1:B29").Value
   vntC = Range("C1:C29").Value
   Range("A1:A29").Value = vntC
   Range("B1:B29").Value = vntA
   Range("C1:C29").Value = vntB
  
End Sub

Bei der Formellösung reicht es, wenn Du in A1 folgende Formel eingibst:

Arbeitsblatt mit dem Namen 'Tabelle1'
	A	B	C	D	E	F	G	H
1	Nacht	Früh	Spät			Früh	Spät	Nacht
2	Gruppe 3	Gruppe 1	Gruppe 2			Gruppe 1	Gruppe 2	Gruppe 3
3	Handy	Uhren	Fotos			Uhren	Fotos	Handy

Zelle	Formel
A1	=INDEX($F$1:$H$29;ZEILE();REST(HEUTE()+SPALTE(C$1)*7+2-REST(HEUTE();7);3)+1)

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

Diese kann nach rechts und nach unten kopiert werden.

[kaptan2002]

nein geht nicht atilla

es muss einfacher gehen, das habe ich schon mal gesehen aber kann mich nicht mehr auf die Tabelle erinnern wo das war.

A1 bis A29 (früh) zu C1 bis C29 (Nacht)
'C1 bis C29 (Nacht) zu B1 bis B29 (Spät)
'B1 bis B29 (Spät) zu A1 bis A29 (Früh)

es sollte immer in dieser Ryhtmus oder schleife weiter gehen.

[kaptan2002]

ich habe das jetzt so mit Makroaufzeichnung gemacht.
Es klappt aber man kann das besser machen ohne aufzeichnung.

Sub Makro1()
'
' Makro1 Makro
'

'
Range("A2:A29").Select
Selection.Copy
Range("F2").Select
ActiveSheet.Paste
Range("A5").Select
Application.CutCopyMode = False
Range("A2:A29").Select
Selection.ClearContents
Range("B2:B29").Select
Selection.Cut
Range("A2").Select
ActiveSheet.Paste
Range("C2:C29").Select
Selection.Cut
Range("B2").Select
ActiveSheet.Paste
Range("F2:F29").Select
Selection.Cut
Range("C2").Select
ActiveSheet.Paste
Range("F13").Select
End Sub

[atilla]

Hallo kaplan,

Das Prinzip hast ja gesehen, dann könntest Du eigentlich selber korrigieren.

Der eingestellte Code dann so:

Code:

'also A1 bis A29 (früh) zu C1 bis C29 (Nacht)
'C1 bis C29 (Nacht) zu B1 bis B29 (Spät)
'B1 bis B29 (Spät) zu A1 bis A29 (Früh)
Sub verschieben()
   Dim vntA As Variant
   Dim vntB As Variant
   Dim vntC As Variant
  
   vntA = Range("A2:A29").Value
   vntB = Range("B2:B29").Value
   vntC = Range("C2:C29").Value
   Range("A2:A29").Value = vntB
   Range("B2:B29").Value = vntC
   Range("C2:C29").Value = vntA
  
End Sub

Du schreibst ab A1 aber meinst ab A2, richtig? Macht auch mehr Sinn.

Dann kann man im Code noch 3 Zeilen einsparen, es reicht dann das:

Code:

Sub verschieben2()
   Dim vntA As Variant
   Dim vntB As Variant
  
   vntA = Range("A2:A29").Value
   vntB = Range("B2:C29").Value

   Range("A2:B29").Value = vntB
   Range("C2:C29").Value = vntA
End Sub

[kaptan2002]

okay super
es klappt nur die Zellen Farben sollen mit wandern geht das auch? kann ich da auch beliebige Zellen Farben auswählen?



vielen Dank atilla

[atilla]

Hallo Kaplan,

wenn Spalte D frei ist, dann ginge es so:

Code:

Sub verschieben3()
    Range("A4:A29").Cut Destination:=Range("D4:D29")
    Range("B4:D29").Cut Destination:=Range("A4:C29")
End Sub

Sonst müsste man in Spalte D eine weitere Spalte einfügen und diese dann nachträglich löschen.

[atilla]

Hallo kaplan,

Der Bereich natürlich ab A2, so:

Code:

Sub verschieben3()
    Range("A2:A29").Cut Destination:=Range("D2:D29")
    Range("B2:D29").Cut Destination:=Range("A2:C29")
End Sub

und so ohne Bildschirmflackern:

Code:

Sub verschieben3()
   Application.ScreenUpdating = False
    Range("A2:A29").Cut Destination:=Range("D2:D29")
    Range("B2:D29").Cut Destination:=Range("A2:C29")
   Application.ScreenUpdating = True
End Sub