• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Eerst wegschrijven en dan pas leeg maken.

Status
Niet open voor verdere reacties.

Drieband

Gebruiker
Lid geworden
30 dec 2011
Berichten
107
Wat de code nu doet werkt prima,maar kan deze aangepast worden zodat hij het ingevulde getal eerst wegschrijft en dan pas leegmaakt?
Mijn dank zou groot zijn.
 

Bijlagen

  • Optellen,wegschrijven en leegmaken.xlsm
    17,4 KB · Weergaven: 45
Test deze eens:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
  .EnableEvents = False
     If Not Intersect(Target, Range("A1")) Is Nothing Then
      Range("B1") = Range("B1") + Range("A1")
       Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = Cells(1, 2)
        Cells(1, 1).ClearContents
     End If
     If Not Intersect(Target, Range("A2")) Is Nothing Then
       Range("B2") = Range("B2") + Range("A2")
        Range("C" & Range("C" & Rows.Count).End(xlUp).Row + 1) = Cells(2, 2)
         Cells(2, 1).ClearContents
     End If
.EnableEvents = True
End With
End Sub
 
Cobbe,eerst en vooral dank u voor je hulp maar helaas ,deze doet niet wat ik er van verwacht.
 
Zou je me eens willen aangeven wat dit bestand niet doet wat in uw vraag vervat zit?
 

Bijlagen

  • Optellen,wegschrijven en leegmaken(cobbe).xlsm
    15,3 KB · Weergaven: 37
Misschien is mijn vraag wat onduidelijk.
Het gene ik wil bereiken is wat je invult in A1 moet vanaf A7 t.e.m. A26 komen te staan en niet de opgetelde som van uit kolom B1,hetzelfde met A2 naar C7 t.e.m. C26,dus A2 naar C7,C8,C9 enz.

Hopelijk is het zo duidelijk voor U,
Dank U
 
Enkel de rode cell-verwijzing aanpassen is voldoende:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
  .EnableEvents = False
     If Not Intersect(Target, Range("A1")) Is Nothing Then
      Range("B1") = Range("B1") + Range("A1")
       Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = [COLOR="#FF0000"]Cells(1, 1)[/COLOR]
        Cells(1, 1).ClearContents
     End If
     If Not Intersect(Target, Range("A2")) Is Nothing Then
       Range("B2") = Range("B2") + Range("A2")
        Range("C" & Range("C" & Rows.Count).End(xlUp).Row + 1) = [COLOR="#FF0000"]Cells(2, 1)[/COLOR]
         Cells(2, 1).ClearContents
     End If
.EnableEvents = True
End With
End Sub
 
Zowel de vraag als het bestand is onduidelijk. Iets in deze vorm zal je wel bedoelen maar dan moet ik wel door driebanden heen lezen. Wees concreet. Plaats een voorbeeld met kolomkoppen, de verwachte uitkomst en nog meer wat je kan om de vraag te verduidelijken. Zie ook #4

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("A1:A2")) Is Nothing Or Target.Count <> 1 Then Exit Sub
    lr = Application.Max(7, Cells(Rows.Count, IIf(Target.Row = 1, 1, 3)).End(xlUp).Row + 1)
    Target.Offset(, 1) = Target.Offset(, 1) + Target
    Cells(lr, IIf(Target.Row = 1, 1, 3)) = Target.Value
    If lr = 26 Then Target.ClearContents
End Sub
 
Cobbe,Vena,

Mijn excuses voor de onduidelijkheid,maar beide oplossingen werken prima en voldoen voor mij.
Er rest me nog wel één vraag,kan dit ook werkzaam gemaakt worden in een beveiligd blad?
Zo ja dan ben ik er helemaal uit.
In ieder geval mijn dank voor jullie beide.
 
Dat kan door gebruik te maken van Unprotect aan het begin van de code en Protect aan het eind van de code.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan