Helpmij.nl
Helpmij.nl
Helpmij.nl

Quote

Weergeven resultaten 1 tot 6 van 6

Onderwerp: Code VBA

  1. #1
    Junior Member
    Geregistreerd
    14 oktober 2021
    Vraag is niet opgelost

    Code VBA

    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 Code:
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    
    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

  2. #2
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Een voorbeeldbestandje zou ook leuk zijn. Ook met de verwachte uitkomsten.
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  3. #3
    Junior Member
    Geregistreerd
    14 oktober 2021
    Quote Origineel gepost door VenA Bekijk Bericht
    Een voorbeeldbestandje zou ook leuk zijn. Ook met de verwachte uitkomsten.
    Hierbij een versimpelde versie. Hopelijk is dit duidelijk...
    TestfileHistoriek.xlsm

  4. #4
    Tera Honourable Senior Member
    Verenigingslid
    OctaFish's avatar
    Geregistreerd
    6 februari 2009
    Locatie
    Rotterdam
    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
    Gebruik de QUOTE knop alleen als je iets wit citeren.
    Op deze pagina kun je zien hoe je met TAGS werkt.

  5. #5
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    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
    Bijgevoegde bestanden Bijgevoegde bestanden
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  6. #6
    Junior Member
    Geregistreerd
    14 oktober 2021
    Quote Origineel gepost door VenA Bekijk Bericht
    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
    Bedankt, dit is exact wat ik zocht.

    Aan al de andere ook bedankt!

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl

Regels
Help

Helpmij.nl en business

Partners
Sponsoren