• 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.

Code VBA

Status
Niet open voor verdere reacties.
M

MarieV8

Nieuwe gebruiker
Lid geworden
14 okt 2021
Berichten
3
Beste,

Ik zou graag de vorige waardes uit een cel in een lijst laten komen op een andere sheet. Zodanig dat we een historiek hebben van de vorige waardes. Hiervoor heb ik een code gevonden maar deze zou nog wat aanpassingen moeten krijgen. Ik heb nu de vorige waardes in de P kolom laten staan aangezien ik het niet kon veranderen naar Sheet2!A1. Kan ik dit misschien wel anders? Ik heb nu gewoon op de andere sheet verwezen naar de P kolom en de P kolom zelf op hide gezet. Ik zou ook graag deze code laten uitvoeren op verschillende cellen (nl. F11 ook op F12,F13,..). Hoe kan ik dit coderen voor de verschillende cellen en deze simultaan laten lopen?

PHP: 
 Dim xVal As String
Private Sub Macro1(ByVal Target As Range)
    Static xCount As Integer
    Application.EnableEvents = False
    If Target.Address = Range("F11").Address Then
        Range("P1").Offset(xCount, 0).Value = xVal
        xCount = xCount + 1
    Else
        If xVal <> Range("F11").Value Then
         Range("P1").Offset(xCount, 0).Value = xVal
        xCount = xCount + 1
        End If
    End If
    Application.EnableEvents = True
End Sub

Alvast bedankt
PS: programmeren is al weer een tijdje geleden dus wat extra uitleg bij de stappen zou leuk zijn :)
 
Een voorbeeldbestandje zou ook leuk zijn. Ook met de verwachte uitkomsten.
 
Bedoel je 'm zo?
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Static xCount As Integer
    Application.EnableEvents = False
    If Target.Address = Range("B2").Address Then
        Sheets("Sheet2").Range("A2").Offset(xCount, 0).Value = xVal
        xCount = xCount + 1
    Else
        If xVal <> Range("B2").Value Then
         Sheets("Sheet2").Range("A2").Offset(xCount, 0).Value = xVal
        xCount = xCount + 1
        End If
    End If
    Application.EnableEvents = True
End Sub

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    xVal = Target.Value
End Sub
 
Als je de wijzigingen netjes wil bijhouden dan schrijf je deze weg in een tabel.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B2:B4")) Is Nothing And Target.Count = 1 Then 'afbaken van het bereik
    Application.EnableEvents = False 'Events uitzetten anders kom je in een oneindige lus
    nw = Target.Value 'sla de nieuwe waarde op in een variabele
    Application.Undo 'ga terug naar de vorige waarde
    old = Target.Value 'sla de oude waarde op in een variabele
    Target = nw 'zet de nieuwe waarde terug
    Sheets("Sheet2").ListObjects(1).ListRows.Add.Range.Resize(, 5) = Array(Target.Offset(, -1).Value, old, nw, Now, Environ("Username")) 'schrijf de gegevens weg naar de tabel in Sheet2
    Application.EnableEvents = True 'Zet de Events weer aan.
  End If
End Sub
 

Bijlagen

  • TestfileHistoriek.xlsm
    18 KB · Weergaven: 22
VenA zei:
Als je de wijzigingen netjes wil bijhouden dan schrijf je deze weg in een tabel.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B2:B4")) Is Nothing And Target.Count = 1 Then 'afbaken van het bereik
    Application.EnableEvents = False 'Events uitzetten anders kom je in een oneindige lus
    nw = Target.Value 'sla de nieuwe waarde op in een variabele
    Application.Undo 'ga terug naar de vorige waarde
    old = Target.Value 'sla de oude waarde op in een variabele
    Target = nw 'zet de nieuwe waarde terug
    Sheets("Sheet2").ListObjects(1).ListRows.Add.Range.Resize(, 5) = Array(Target.Offset(, -1).Value, old, nw, Now, Environ("Username")) 'schrijf de gegevens weg naar de tabel in Sheet2
    Application.EnableEvents = True 'Zet de Events weer aan.
  End If
End Sub
Klik om te vergroten...

Bedankt, dit is exact wat ik zocht.

Aan al de andere ook bedankt!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan