Cellen automatisch op "0"

[Allrounditer]

ik heb vier cellen: A1, A2,A3,A4

Als ik iets in A1 invul, dan wil ik dat de andere drie cellen (A2,A3,A4) "0" weergeven.
Vul ik iets in A2, dan wil ik ook dat de andere drie cellen (A1,A3,A4) "0" weergeven, enz...
heeft iemand een oplossing?

Bedankt alvast

 

[HSV]

Met zoiets.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim old
If Not Intersect(Target, Range("a1:a4")) Is Nothing Then
 Application.EnableEvents = False
   old = Target
   Application.Undo
   Range("a1:a4").Value = 0
   Target = old
 Application.EnableEvents = True
End If
End Sub

 

[Allrounditer]

Bedankt voor je snelle reactie.
Ik de code proberen toe te voegen, maar het geeft geen effect.
In bijlage mijn projectje.

Bekijk bijlage Kasboek project.xlsm

 

[HSV]

Het geef het resultaat van de vraag.
Helaas komt het bestand niet overheen met de vraag.
Hier is de code voor je bestand.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim old
If Not Intersect(Target, Range("F7:I100")) Is Nothing Then
 Application.EnableEvents = False
   old = Target
   Application.Undo
   Cells(Target.Row, 6).Resize(, 4).Value = 0
   Target = old
 Application.EnableEvents = True
End If
End Sub

 

[Allrounditer]

Thx Harry, werkt perfect!

 

[HSV]

Graag gedaan.

 

[Allrounditer]

Ik heb nog een vraag. Mijn doel vind je hieronder. Is zoiets per VBA mogelijk?


als omschrijving (kolom C) = Overschrijving naar rekening
dan is soort (kolom E) = Overboeking
EN
dan is kas IN = "-"
dan is rekening IN en OUT ="-"
EN
dan is volgende rij:
datum = aan datum vorige datum
omschrijving = storting op rekening
soort = aan vorige soort
kas IN en OUT = "-"
rekening UIT="-"

alvast bedankt voor je inspanningen.

 

[HSV]

Moet dat samen met de andere code, of wil je die niet meer?

 

[Allrounditer]

jawel hoor, wil ik zeker nog. Mag dus samen.

 

[Allrounditer]

en ja, bij rekening IN op de nieuwe rij, moet hetzelfde bedrag komen als het bedrag op de vorige lijn Kas OUT.
Sorry

 

[HSV]

Er is één maar...., je moet bij een overboeking wel eerst het volgnummer, datum en het bedrag invullen, anders worden die in de volgende rij niet meegenomen.

Test het maar eens.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim old
If Not Intersect(Target, Union(Range("C8:D100"), Range("F8:I100"))) Is Nothing Then
 Application.EnableEvents = False
 With Target
   Select Case .Column
    Case 3, 4
        If LCase(.Value) = "overschrijving naar rekening" Then
            .Offset(, 1).Resize(, 2) = Array("Overboeking", "-")
            .Offset(, 4).Resize(, 2) = "-"
            .Offset(1, -2).Resize(, 6) = Array(.Offset(, -2) + 1, .Offset(, -1), "Storting op rekening", , "Overboeking", "-", "-")
            .Offset(1, 4).Resize(, 2) = Array(.Offset(, 3), "-")
        End If
    Case 6, 7, 8, 9
        old = .Value
        Application.Undo
        Cells(.Row, 6).Resize(, 4).Value = "-"
       .Value = old
    End Select
  End With
 Application.EnableEvents = True
End If
End Sub

 

[Allrounditer]

ik heb het uitgetest en er gebeurt helaas niets.
Ik heb de eerste code tijdelijk als "comment" geplaatst en de nieuwe er dan onder geplaatst anders heb ik twee maal private sub worksheet_change ...
De kolommen C en D zijn wel samengevoegd. Tussen Omschrijving en Soort is er dus geen kolom meer in het kasboek. Het gaat dus van omschrijving (kolom C) naar Soort (kolom E).
Heeft het daarmee te maken?

 

[Allrounditer]

CASE 6, 7, 8, 9 doen het oude werk (heb ik nu pas door) --> dat werkt nog altijd perfect
alleen werkt CASE 3,4 niet ...

 

[Allrounditer]

OK, verder aan het testen geweest.

Het werkt wel!
Enkel nog één foutje, bij Kas UIT op de volgende rij (die automatisch werd ingevuld) wordt geen "-" geplaatst.
Voor de rest werkt het perfect.

 

[Allrounditer]

ik heb de code eens als volgt aangepast:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim old
If Not Intersect(Target, Union(Range("C9:D100"), Range("F9:I100"))) Is Nothing Then
 Application.EnableEvents = False
 With Target
   Select Case .Column
    Case 3, 4
        If LCase(.Value) = "overschrijving naar rekening" Then
            .Offset(, 1).Resize(, 2) = Array("Overboeking", "a")
            .Offset(, 4).Resize(, 2) = "b"
            .Offset(1, -2).Resize(, 6) = Array(.Offset(, -2) + 1, .Offset(, -1), "Storting op rekening", , "Overboeking", "c", "d")
            .Offset(1, 4).Resize(, 2) = Array(.Offset(, 3), "e")
        End If
    Case 6, 7, 8, 9
        old = .Value
        Application.Undo
        Cells(.Row, 6).Resize(, 4).Value = "-"
       .Value = old
    End Select
  End With
 Application.EnableEvents = True
End If
End Sub

het resultaat:


waarom wordt "d" niet ingevuld?

 

[HSV]

Verander de 6 in een 7.

.Offset(1, -2).Resize(, [COLOR=#ff0000][SIZE=3]6[/SIZE][/COLOR]) = Array(.Offset(, -2) + 1, .Offset(, -1), "Storting op rekening", , "Overboeking", "c", "d")

.Offset(1, -2).Resize(, [COLOR=#ff0000][SIZE=3]7[/SIZE][/COLOR]) = Array(.Offset(, -2) + 1, .Offset(, -1), "Storting op rekening", , "Overboeking", "c", "d")

 

[Allrounditer]

Prima, werkt!
Bedankt

 

[HSV]

Kleine aanpassing als kolom A en B nog niet gevuld zijn.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim old
Application.EnableEvents = False
If Not Intersect(Target, Union(Range("C8:D100"), Range("F8:I100"))) Is Nothing Then
 With Target
  Select Case .Column
    Case 3, 4
     If Application.CountA(Cells(.Row, 1).Resize(, 2)) = 2 Then
        If LCase(.Value) = "overschrijving naar rekening" Then
            .Offset(, 1).Resize(, 2) = Array("Overboeking", "-")
            .Offset(, 4).Resize(, 2) = "-"
            .Offset(1, -2).Resize(, 7) = Array(.Offset(, -2) + 1, .Offset(, -1), "Storting op rekening", , "Overboeking", "-", "-")
            .Offset(1, 4).Resize(, 2) = Array(.Offset(, 3), "-")
         End If
        Else
            MsgBox "De eerste twee kolommen graag invullen"
            .Value = ""
            Application.EnableEvents = True
            Exit Sub
        End If
    Case 6, 7, 8, 9
        old = .Value
        .Value = ""
        Cells(.Row, 6).Resize(, 4).Value = "-"
       .Value = old
    End Select
  End With
End If
Application.EnableEvents = True
End Sub