'AfterChange' functionaliteit binnen Excel

Status
Niet open voor verdere reacties.

hfoppen

Terugkerende gebruiker
Lid geworden
15 nov 2000
Berichten
1.058
Beste mensen,

ik heb een Excelfile met een invoegtoepassing waarbij ik gegevens uit ons ERP-systeem binnenhaal. Hierin kunnen gegevens worden aangepast waarbij deze vervolgens 'met een druk op de knop' weer kunnen worden teruggeschreven.
Omdat het soms om 20000 regels gaat die worden ingelezen wil ik ervoor zorgen dat bij het terugschrijven enkel de gewijzigde regels worden gelezen om bij te werken.

Wat ik heb gedaan is een kolom "BQ" gereserveerd voor 'changed'. Onder de code van Blad1 heb ik de volgende code:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   'Do nothing if more than one cell is changed or content deleted
   If IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("M3:M2500")) Is Nothing Then

       'Ensure target is a number before multiplying by 2
       ' If IsNumeric(Target) Then

            'Stop any possible runtime errors and halting code
            On Error Resume Next

                Range("BQ" & ActiveCell.Row - 1).Value = "x"

                'Turn events back on
                Application.EnableEvents = True

            'Allow run time errors again
            On Error GoTo 0
        'End If
    End If

    If Not Intersect(Target, Range("E3:E2500")) Is Nothing Then

       'Ensure target is a number before multiplying by 2
       ' If IsNumeric(Target) Then

            'Stop any possible runtime errors and halting code
            On Error Resume Next

                Range("BQ" & ActiveCell.Row - 1).Value = "x"

                'Turn events back on
                Application.EnableEvents = True

            'Allow run time errors again
            On Error GoTo 0
        'End If
    End If

End Sub

Zoals je kunt zien heb ik 2 kolommen die in aanmerking komen voor wijzigingen. Eigenlijk ook nog een 3e kolom, maar die heb ik niet in deze versie staan.
Kortom: in kolommen E, M & N staat een waarde. Als die wordt aangepast moet in kolom BQ een 'x' komen te staan.

Huidige problemen:
- Niet altijd wordt dit getriggerd, dus niet altijd komt er een 'x' te staan
- Bovenstaande code werkt niet met 'slepen'. Je moet echt een enter geven om ervoor te zorgen dat code wordt geactiveerd.

Wie heeft er de oplossing voor mijn proble(e)m(en)?

Herbert
 
Je kunt de waarden uit de database ook 2x in het werkblad zetten. 1x daar waar het nu staat en 1x in verborgen kolommen. In de cel waar de x (BQ) komt te staan zet je dan een formule die controleert of de zichtbare en de verborgen kolommen aan elkaar gelijk zijn. Zoniet dan plaatst de formule een x. Zodoende kan het dan ook zonder VBA en werkt het ook na 'slepen'.
 
Laatst bewerkt:
Dat klinkt goed! Dat ik daar zelf niet op gekomen ben ;).
Ga dit uitproberen. Heb je misschien nog een tip hoe ik ervoor kan zorgen dat de inhoud van kolom BQ dan ook in alle regels komt te staan bij de import?
Of moet ik die in de template gewoon vast vullen? (zou goed moeten gaan omdat hij dan "" en "" vergelijkt.

Heb nu de formule als volgt: =ALS(BT7=BU7;"";"x")
 
Beste,

kom er nog niet helemaal uit.
Heb nu de kolommen E, N & M ook als kopie ingelezen (in de kolommen BR, BS en BT). In kolom "BU" heb ik nu een formule gezet:

Code:
=ALS(E6=BR6;"";"x")

Echter lukt het me niet om die andere 2 vergelijken (N tov BS & M tov BT) mee te nemen in zelfde formule.
Iets als:

Code:
=ALS((E6=BR6) OF (N6=BS6) OF (M6=BT6);"";"x")


Herbert
 
Voor een OF vergelijking klopt die functie in ieder geval niet, daarnaast wil je volgens mij een EN vergelijking.
Ik heb er zo niet direct goed zicht op denk ik, maar probeer deze eens in BU6:
Code:
=ALS(EN(E6=BR6;N6=BS6;M6=BT6);"";"x")
 
Laatst bewerkt:
Top! Dit lijkt gewoon goed te werken edmoor. Bedankt.
Was nog even lastig omdat ik voor 't importeren alle records verwijder, maar heb in de import nu stukje code toegevoegd die de formule in cel plakt ;)

Code:
    Range("BU3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-68]=RC[-3],RC[-60]=RC[-2],RC[-59]=RC[-1]),"""",""x"")"
    Range("BU3").Select
    Selection.AutoFill Destination:=Range("BU3:BU20000"), Type:=xlFillDefault
    Range("A3").Select

Nogmaals bedankt.
 
Ok dan :thumb:
 
Select in code is in 99% v/d gevallen overbodig.
Code:
    With Range("BU3")
        .FormulaR1C1 = "=IF(AND(RC[-68]=RC[-3],RC[-60]=RC[-2],RC[-59]=RC[-1]),"""",""x"")"
        .AutoFill Range("BU3:BU20000"), xlFillDefault
    End With
    Application.Goto Range("A3"), True
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan