Tabellenbereich mit Makros kopieren

[Oegli]

Hallo zusammen,

ich bin gerade dabei eine kleine Produktionsplanung zu erstellen.

Dazu werden mithilfe von 4 Buttons die jeweiligen Zellwerte oberhalb erhöht.
Nun möchte ich diesen Bereich kopieren und auf alle weiteren Kalenderwochen anwenden.
Dabei werden aber die fixen Zellbezüge mitkopiert und immer nur auf die erste Kalenderwoche angewendet.

Wie kann ich Makros umschreiben, damit die Zellbezüge beim kopieren angepasst werden?


Danke!



  Test 1-Ben.xlsm (Größe: 44,83 KB / Downloads: 9)

[HKindler]

Hi,

wenn du das so machst wie du es bisher vor hast, dann hast du am Ende über 200 Buttons in deiner Datei. Das ist jede Menge Overhead. Und theoretisch müsstest du für jeden Button ein eigenes Makro haben. Viel Spaß, falls sich mal etwas am Aufbau deiner Datei ändert weil du z.B. eine Zeile oder Spalte einfügen musst. 

Du könntest jetzt natürlich die Position des Buttons Auswerten, die entsprechende Spalte suchen und anhand dessen die notwendige Zelle berechnen. Dann brauchst du nur noch 4 oder sogar nur 1 Makro (aber immer noch die 200+ Buttons) und eine entsprechend aufwändige Programmierung.

Ich würde daher auf die Buttons verzichten und einfach die Zellen selbst als Button verwenden. Dafür gibt es in Excel das Event Worksheet_BeforDoubleClick(), das in den CodeBereich des entsprechenden Tabellenblatts gehört.

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
With Target.Cells(1)
    Select Case .Value
        Case "Kategorie A"
            .Offset(, 1) = .Offset(, 1) + 1
        Case "Kategorie B"
            .Offset(, 1) = .Offset(, 1) + 2
        Case "Kategorie C"
            .Offset(, 1) = .Offset(, 1) + 3
        Case "Kategorie D"
            .Offset(, 1) = .Offset(, 1) + 6
        Case Else
            Cancel = False
    End Select
End With
End Sub

---

An die VBA-Profis hier: Ich habe einen seltsamen Effekt festgestellt. Bei den fraglichen Zellen handelt es sich um Verbundzellen bestehend aus zwei horizontal benachbarten Zellen (z.B. B8:C8). Daher auch das Target.Cells(1), um nur die erste Zelle anzusprechen. Sonst gibt Target.Value nämlich ein Array zurück.

Jetzt will ich ja eigentlich eine Zelle zwei Zellen weiter rechts von dieser ansprechen (z.B. D8). Trotzdem gibt Target.Cells(1).Offset(,2) die Zelle E2 zurück. Um D2 zu erreichen brauche ich einen .Offset(,1). Was ist hier los?
Target.Cells(1).Offset(,0) gibt wie erwartet B8 zurück. Wie könnte man nun C8 erreichen?

Bug oder Festure?

[Gast 123]

Hallo

ich denke ich habe eine Lösung über den VBA Befehl:   Shapes.TopLeftCells

Dieser Befehl setzt zwingend voraus das der Button nicht genau auf dem Zellrand stehen darf, dann kann es passieren das mal die rechte oder linke Zelle als TopLeftCells erkannt wird!  Weiss man in welcher Spalte der Button steht, kann man die zu addierende Zelle über Offset ermitteln.

Für 1. und 2. KWoche funktionieren die Buttons als Demo.  Die Buttongrösse sollte an die Zelle angepasst sein.
Der Vorteil ist, das man die Button A-D (mit Makro) als Block kopieren, und in die nächste KWoche einfügen kann.
Das Makro sollte bei korrekter Positionierung für alle 52 KWochen korrekt laufen.

Alternativ wäre nur einen vierer Block Button  erstellen, und den immer in die aktuelle KWoche verschieben.
Würde mich freuen wenn diese Lösung weiterhilft.

mfg Gast 123

---

Nachtrag:   mein Demo läuft nur in den ersten beiden Kalenderwochen. Den Rest bitte selbst einrichten:

[snb]

Vielleicht the other way around:

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Cancel = True

  With Target.Cells(2)
    .Value = .Value + Asc(Right(.Offset(, -1).Value, 1)) - 64
  End With
End Sub

[Oegli]

Hallo

ich denke ich habe eine Lösung über den VBA Befehl:   Shapes.TopLeftCells

Dieser Befehl setzt zwingend voraus das der Button nicht genau auf dem Zellrand stehen darf, dann kann es passieren das mal die rechte oder linke Zelle als TopLeftCells erkannt wird!  Weiss man in welcher Spalte der Button steht, kann man die zu addierende Zelle über Offset ermitteln.

Für 1. und 2. KWoche funktionieren die Buttons als Demo.  Die Buttongrösse sollte an die Zelle angepasst sein.
Der Vorteil ist, das man die Button A-D (mit Makro) als Block kopieren, und in die nächste KWoche einfügen kann.
Das Makro sollte bei korrekter Positionierung für alle 52 KWochen korrekt laufen.

Alternativ wäre nur einen vierer Block Button  erstellen, und den immer in die aktuelle KWoche verschieben.
Würde mich freuen wenn diese Lösung weiterhilft.

mfg Gast 123

---

Nachtrag:   mein Demo läuft nur in den ersten beiden Kalenderwochen. Den Rest bitte selbst einrichten:

Hervorragend!

Vielen herzlichen Dank!

Damit kann ich definitiv arbeiten und nun wird verfeinert!

Tolles Forum - Tolle Hilfe! 

[Oegli]

Jetzt ist doch noch eine weitere Frage aufgetaucht.
Ich hätte gerne das beim Öffnen der Datei automatisch der aktuelle Tag markiert und quasi zentriert wird.
So hätte jeder User automatisch die aktuelle Woche vor sich.
Habe schon die verschiedensten Makros aus dem Netz probiert, aber beim öffnen tut sich nichts.

Was muss ich einbauen damit es funktioniert?

Danke vorab!

[00202]

Hallo,  

so:

Code:

Option Explicit
Private Sub Workbook_Open()
    Tabelle1.Cells(6, Application.Match(CLng(Date), Tabelle1.Rows(6), 0)).Select
End Sub

Der Code gehört in "DieseArbeitsmappe"!!

Alternativ auch mit dieser Codezeile:  

Code:

Application.Goto Tabelle1.Cells(2, Application.Match(CLng(Date), Tabelle1.Rows(6), 0) - 6), True

[Oegli]

Hallo,  

so:

Code:

Option Explicit
Private Sub Workbook_Open()
    Tabelle1.Cells(6, Application.Match(CLng(Date), Tabelle1.Rows(6), 0)).Select
End Sub

Der Code gehört in "DieseArbeitsmappe"!!

Alternativ auch mit dieser Codezeile:  

Code:

Application.Goto Tabelle1.Cells(2, Application.Match(CLng(Date), Tabelle1.Rows(6), 0) - 6), True

Perfekt, klappt auf Anhieb!

Vielen Dank!

[HKindler]

Hi,

bitte nur quoten, wenn es notwendig ist (wenn der Text direkt darüber steht, ist es sicherlich nicht notwendig!). Und selbst dann keine Fullquotes.

[Kuwer]

Hallo Helmut,

Offset geht anscheinend immer von der letzten Zelle des Verbundes aus.
Mit der Worksheets.Cells-Eigenschaft klappt es besser:

Code:

MsgBox Cells(Target.Row, Target.Cells(1).Column + 2).Address

Gruß Uwe