Microsoft Excel

Herbers Excel/VBA-Archiv

Werte automatisch rücken



Excel-Version: 10.0 (Office XP)

Betrifft: Werte automatisch rücken
von: Gerald
Geschrieben am: 06.06.2002 - 19:39:13

Hallo, folgendes problem:

in Zelle C1 steht ein Wert der alle 3 Wochen neu generiert wird.
Wenn ich nun in Zelle B1 ein Datum eingebe, soll Excel diesen aktuellen Wert in Zelle A1 anzeigen.
Wenn ein neues datum in Zelle B1 eingegeben wird, soll der aktuelle Wert aus Zelle C1 in A2 angezeigt werden. Beim nächsten Datum in B1, soll der Wert in Zelle A3 angezeigt werden.
Aber nun kommt es ganz dicke:
Wenn ich nun wieder ein datum in Zelle B1 eingebe, soll der Wert in Zelle A1 verschwinden, der Wert aus Zelle A2 auf A1 rücken und der Wert aus A3 auf A2 rücken, uns schließlich der aktuelle Wert aus C1 in Zelle A3 angezeigt werden.

Ich hoffe auf ein wenig Hilfe.

  

Re: Werte automatisch rücken
von: Uwe Wassmann
Geschrieben am: 06.06.2002 - 19:58:37

Hi,

probier mal:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)

If Cells(2, 1) <> "" And Cells(3, 1) <> "" Then
wert = Cells(3, 1)
If Cells(1, 1) = "" And Cells(1, 2) = "" And Cells(1, 3) = "" Then
Cells(1, 1) = wert
GoTo ende
End If
If Cells(1, 1) <> "" And Cells(1, 2) = "" And Cells(1, 3) = "" Then
Cells(1, 2) = wert
GoTo ende
End If
If Cells(1, 1) <> "" And Cells(1, 2) <> "" And Cells(1, 3) = "" Then
Cells(1, 3) = wert
GoTo ende
End If
If Cells(1, 1) <> "" And Cells(1, 2) <> "" And Cells(1, 3) <> "" Then
wert1 = Cells(1, 2)
wert2 = Cells(1, 3)
Cells(1, 1) = wert1
Cells(1, 2) = wert2
Cells(1, 3) = wert
End If
End If
ende:
Cells(3, 1).ClearContents
End Sub


gruß
Uwe

  

Re: Werte automatisch rücken
von: WernerB.
Geschrieben am: 06.06.2002 - 20:11:52

Hallo Gerald,

teste doch mal diesen Code.

Schreibe/kopiere das nachstehende Makro in das Klassenmodul des betreffenden Tabellenblattes.

- Mache dazu einen Rechtsklick auf den Tabellennamen.
- Klicke dann auf "Code anzeigen".
- Automatisch öffnen sich nun der VB-Editor und das Klassenmodul des betreffenden Tabellenblattes.
- Schreibe/kopiere das nachstehende Makro in die große weiße Fläche auf der rechten Seite.
- Zurück zum "normalen" Excel geht's mit Alt + Q.
- Fertig.


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Address(False, False) <> "B1" Then Exit Sub
    If IsEmpty(Range("B1")) Or Not IsDate(Range("B1")) Then Exit Sub
    If Not IsEmpty(Range("A1")) And Not IsEmpty(Range("A2")) And _
      Not IsEmpty(Range("A3")) Then
        Range("A1").Value = Range("A2").Value
        Range("A2").Value = Range("A3").Value
        Range("A3").Value = Range("C1").Value
    End If
    If Not IsEmpty(Range("A1")) And Not IsEmpty(Range("A2")) And _
      IsEmpty(Range("A3")) Then Range("A3").Value = Range("C1").Value
    If Not IsEmpty(Range("A1")) And IsEmpty(Range("A2")) And _
      IsEmpty(Range("A3")) Then Range("A2").Value = Range("C1").Value
    If IsEmpty(Range("A1")) And IsEmpty(Range("A2")) And _
      IsEmpty(Range("A3")) Then Range("A1").Value = Range("C1").Value
End Sub

Viel Erfolg wünscht
WernerB.

  

Re: Werte automatisch rücken
von: Gerald
Geschrieben am: 07.06.2002 - 07:14:52

hallo Werner,
danke für den Tip, klappt einwandfrei.
Ist es eigentlich auch möglich in einer weiteren Spalte zu jedem Wert das datum automatisch zuzuordnen

  

Re: Werte automatisch rücken
von: WernerB.
Geschrieben am: 07.06.2002 - 20:02:36

Hallo Gerald,

da die Spalten A, B, und C (zumindest in der Zeile 1) bereits belegt sind, habe ich für die Datumseinträge die Spalte D gewählt.


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Address(False, False) <> "B1" Then Exit Sub
    If IsEmpty(Range("B1")) Or Not IsDate(Range("B1")) Then Exit Sub
    If Not IsEmpty(Range("A1")) And Not IsEmpty(Range("A2")) And _
      Not IsEmpty(Range("A3")) Then
        Range("A1").Value = Range("A2").Value
        Range("A2").Value = Range("A3").Value
        Range("A3").Value = Range("C1").Value
        Range("D1").Value = Range("D2").Value
        Range("D2").Value = Range("D3").Value
        Range("D3").Value = Range("B1").Value
    End If
    If Not IsEmpty(Range("A1")) And Not IsEmpty(Range("A2")) And _
      IsEmpty(Range("A3")) Then
      Range("A3").Value = Range("C1").Value
      Range("D3").Value = Range("B1").Value
    End If
    If Not IsEmpty(Range("A1")) And IsEmpty(Range("A2")) And _
      IsEmpty(Range("A3")) Then
      Range("A2").Value = Range("C1").Value
      Range("D2").Value = Range("B1").Value
    End If
    If IsEmpty(Range("A1")) And IsEmpty(Range("A2")) And _
      IsEmpty(Range("A3")) Then
      Range("A1").Value = Range("C1").Value
      Range("D1").Value = Range("B1").Value
    End If
End Sub

Viel Erfolg wünscht
WernerB.

 

Beiträge aus den Excel-Beispielen zum Thema "Werte automatisch rücken "