Excel 2010 VBA Inhalt "Werte fixieren"

[sdf0815]

Hey Ho,

ich hab Folgendes Problem:
- Ich habe eine Tabelle die teilweise automatisiert ausgefüllt wird. (z.B. Spalte D)
- Ein anderer Teil wird manuell ausgefüllt (Spalte F)

Nun brauche ich einen Makro, der die Spalte F überwacht. Sollte ein Eintrag in z.B. F5 gemacht werden sollen die Formeln sich in D5 nicht mehr ändern. Die manuelle Lösung wäre strg-c, strg-v "Werte übernehmen".

In der Theorie alles kein Problem - Nur ich kann vba leider überhaupt nicht :.(

Kann mir bitte jemand helfen folgende Funktion vba-konform zu schreiben:

Überwache die Zellen von Spalte F
If Zelle in F nicht mehr leer
schalte Formeln in betreffender Zelle in Spalte D aus. (zb. über einen aufgenommen Makro strg-c-v-werte)
endif

Danke schon mal

 

[Mithrandil]

Hier mal ein einfacher Lösungsvorschlag (kann sicher noch erweitert werden):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim zeile As Long

  If Target.Column = 6 Then
    zeile = Target.Row
    If Target.Value > 0 Then
      Tabelle1.Cells(zeile, 4) = Target.Value
    End If
    
  End If
End Sub

mit dem VBA Editor (Alt+F11) beim Arbeitsblatt einfügen...

Das ganze reagiert auf das Worksheet-Ereignis "Change" , also wenn eine Zelle geändert wird und fragt ab, ob es die 6te Spalte betrifft (also F). Wenn dort ein Wert >0 eingetragen wurde , wird Spalte D überschrieben.

Das Arbeitsblatt hat in meine Beispiel die "interne" Bezeichnung : Tabelle1
Man könnte statt "Tabelle1." auch "Application.ActiveSheet." schreiben.

 

[Lutz]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("F2:F10")) Is Nothing Then Exit Sub
'Dein Code
End Sub

Den Range kannst Du auch dynamisch gestalten, dafür musst du die anzahl der Zeilen der Tabelle kennen. Das geht mit Worksheets("TabelleX").Rows.Count

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("F2:" & Worksheets("TabelleX").Rows.Count)) Is Nothing Then Exit Sub
'Dein Code
End Sub

 

[sdf0815]

Mithrandil,

Vielen Dank!

Die Funktion machte zwar noch nicht das was ich wollte, aber Sie hat mir die Grundlage gegeben die ich braucht ^^

Meine funktionierende Funktion sieht nun so aus:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim zeile As Long
 
  If Target.Column = 6 Then
    zeile = Target.Row
    If Target.Value > 0 Then
      Tabelle1.Cells(zeile, 4) = Tabelle1.Cells(zeile, 4)
      Tabelle1.Cells(zeile, 5) = Tabelle1.Cells(zeile, 5)
      Tabelle1.Cells(zeile, 3) = Tabelle1.Cells(zeile, 3)
      Tabelle1.Cells(zeile, 2) = Tabelle1.Cells(zeile, 2)
    End If
  End If
End Sub

Danke auch an Dich Lutz,

Grüße
sdf0815

 

[Mithrandil]

@Lutz:
Das mit dem Intersect ist eine gute Idee, um zu prüfen, ob überhaupt die betroffene Spate geändert wurde.
Ich habe nochmal eine Verbesserung vorgenommen, weil das Makro abstürzt, wenn jemand mit Copy+Paste mehrere Zellen einfügt....

Private Sub Worksheet_Change(ByVal Target As Range)
Dim l_zeile As Long, l_cell As Range

For Each l_cell In Target.Cells

  If l_cell.Column = 6 Then
    l_zeile = l_cell.Row
    
    If l_cell.Value > 0 Then
      Application.ActiveSheet.Cells(l_zeile, 4) = l_cell.Value
    End If
    
  End If
  
Next l_cell
End Sub

In dieser Variante wird die Range in Zellen zerlegt....

 

[sdf0815]

Danke^^ War zwar nicht nötig, aber so ist es sauber.


wo wir grad dabei sind... würd ich grad nach noch einem Feature fragen ^^
wenn ich jetzt noch die Möglichkeit haben will die Änderung Rückgängig zu machen:

     If l_cell.Value = "Standard" Then
     Application.ActiveSheet.Cells(l_zeile, 2) = "=WENN(C2=--TEXT(HEUTE();"JJMMTT");B2+1;1)"
     Application.ActiveSheet.Cells(l_zeile, 6) = ""
     
     End If

Der Code soll wenn man "Standard" eintippt automatisch die Schleife ausführen. Die Schleife habe ich nah der anderen eingefügt.
Ich habe Probleme mit 1. den Anführungszeichen von der Text-Funktion und 2. er prüft den Standard nicht und 3. die Zellen werden noch nicht dynamisch vergeben.

Grüße
sdf0815

Ergänzung (9. Februar 2013)

Habs gelöst,

nicht die schönste Lösung aber es geht.

Vielen Dank
sdf0815