checken voor dubbele waarden en verwijderen oude waarden

Status
Niet open voor verdere reacties.
L

leonhnoel

Gebruiker
Lid geworden
4 mei 2016
Berichten
58
Hallo,

Ik heb een bestand wat ik met een leverancier deel. Het betreft statische data: orderregels (kolommen A - J), twee kolommen met formules (K-L) en twee kolommen met feedback van de leverancier (M-N).

Iedere week wil ik uit ons systeem de orderregels halen die nog open staan. Deze wil ik in het bestand voegen door ze eronder te plakken (kolommen A-J).

Regels die de week ervoor al open stonden staan logischerwijs al in het bestand. Ik heb voor elkaar dat deze doublures worden verwijderd via dubbele waarden verwijderen.

Vraag:
Regels die al in het bestand staan, maar die ik een week later niet toevoeg (omdat ze kennelijk afgesloten zijn) moeten automatisch verwijderd worden.

Hoe kan ik dit doen??

Alle regels verwijderen en dan de gegevens plakken werkt niet, want dan moet de leverancier weer voor alle regels zijn commentaar opschrijven.

Dus als ik een aantal regels toevoeg moet het volgende gebeuren:

nieuwe regels -> nieuwe regel bewaren
oude regels die nog steeds voorkomen -> oude regel bewaren
oude regels die niet meer voorkomen -> oude regel verwijderen

het laatste lukt mij niet.


Hoop dat de vraag duidelijk is. :)

Groet,
leonhnoel
 

Bijlagen

  • Voorbeeld.xlsm
    21,6 KB · Weergaven: 28
Laatst bewerkt:
En hoe zouden wij te weten kunnen komen wat de nieuwe regels zijn?
 
Ik heb het bestand aangepast. In het tweede tabblad zit data zoals ik die uit het systeem zou kunnen halen.

Als ik deze onder de data plak op tabblad "PO's" zou:

de schuingedrukte data op dit tabblad moeten verdwijnen omdat deze in de nieuwe data niet meer voorkomt.
de niet opgemaakte data elke regel één maal voor moeten komen (dubbelingen dus verwijderd).
de groen gearceerde data op tabblad "PO's" zou ook op het tabblad PO's voor moeten komen.

Hoop dat iemand kan helpen!

Groet,
leonhnoel
 

Bijlagen

  • Voorbeeld (1).xlsm
    40,4 KB · Weergaven: 26
zijn de gekleurde rijen dubbelingen ? of met welke kolommen moet er rekening worden gehouden?
 

Bijlagen

  • Zoeken en weergeven .xlsm
    42 KB · Weergaven: 24
Alle data van tabblad "nieuwe data" moet onder de data op tabblad "POs" geplaatst worden.

Idealiter zou ik dan zien dat de schuin en dikgedrukte data op tabblad POs" verdwijnt, aangezien deze regels niet voorkomen in de nieuwe data.

De rest van de data moet vervolgens verwerkt worden zoals dat nu al gebeurt (dubbelingen verwijderen).
 
Wat maakt het unieke Id voor jouw gegevens? Ik heb maar wat samengevoegd

De uitkomst komt op een nieuw blad

Code: 
Sub VenA()
  ar = Sheets("POs").Cells(1).CurrentRegion
  ar1 = Sheets("Nieuwe Data").Cells(1).CurrentRegion.Resize(, 14)
  Set d = CreateObject("Scripting.Dictionary")
  For j = 2 To UBound(ar1)
    c00 = ar1(j, 1) & "|" & ar1(j, 2) & "|" & ar1(j, 3) & "|" & ar1(j, 4) & "|" & ar1(j, 5) & "|" & ar1(j, 6) & "|" & ar1(j, 7)
    d(c00) = Application.Index(ar1, j, 0)
  Next j
  For j = 2 To UBound(ar)
    c00 = ar(j, 1) & "|" & ar(j, 2) & "|" & ar(j, 3) & "|" & ar(j, 4) & "|" & ar(j, 5) & "|" & ar(j, 6) & "|" & ar(j, 7)
    If d.Exists(c00) Then
      x = d(c00)
      x(11) = ar(j, 11)
      x(12) = ar(j, 12)
      x(13) = ar(j, 13)
      x(14) = ar(j, 14)
      d(c00) = x
    End If
  Next j
  Sheet1.Cells(1).CurrentRegion.Resize(d.Count, 14) = Application.Index(d.items, 0, 0)
End Sub
 
Laatst bewerkt:
Het unieke ID is een combinatie van kolommen 1-6, 8 en 10.

Als ik de code uitvoer krijg ik de melding dat een object vereist is. Wat is er dan mis?

Wat ik begrijp uit je code is dat er een soort bibliotheek van de data wordt aangelegd.
Als dit het geval is, is het ook mogelijk om de data op tabblad PO's te laten verwijderen en vervolgens de nieuwe data in te voegen? In plaats van de output op een nieuw tabblad te zetten?

Daarnaast zou in de uiteindelijke situatie de nieuwe data direct ingevoegd worden onder alle bestaande regels van tabblad POs.
Nu wordt er nog naar twee tabbladen verwezen. Hoe zou dit omgezet kunnen worden?
 
Als je onderstaande range pakt moet het volgens mij goed gaan.

lLastRow13 geeft het laatste rijnummer van de oude date.
lLastRow1 geeft het laatste rijnummer van de nieuwe data.
Als je daarna de code van VenA gebruikt zou het moeten werken.
Ik krijg alleen een foutmelding "door de toepassing of door object gerelateerde fout".


Code: 
  Dim lLastRow1 As Long
  Dim lLastRow13 As Long
  
  lLastRow13 = Cells(Rows.Count, 13).End(xlUp).Row
  lLastRow1 = Cells(Rows.Count, 1).End(xlUp).Row
  
  ar = Sheets("POs").Range("A" & lLastRow13 + 1 & "N" & lLastRow1)
  ar1 = Sheets("POs").Range("A4:N" & lLastRow13)
 
Werkt gewoon in het voorbeeldbestand. heb je wel een nieuwe tab aangemaakt?
 

Bijlagen

  • Voorbeeld (1) (2).xlsb
    27,5 KB · Weergaven: 30
Werkt bij mij nu ook.

Enig idee hoe ik de range kan aanpassen (zie laatste bericht van mij)? :) Dan kan ik het nieuwe blad omzeilen en met worksheet_change blijven werken.
 
Kolom 13 is leeg en dan gaat het niet werken. Met de datums gaat het niet goed tenzij je op een Engelstalig systeem werkt. Waarom via een worksheet_change? Bij elke wijziging wordt steeds de code uitgevoerd.
 
Ok, het direct vervangen op dezelfde pagina werkt nu. Ik heb hem inderdaad niet meer met worksheet_change staan.

Weet je hoe ik de data goed krijg? Als ik de code draai wordt het format aardig door elkaar gegooid (lees: verschillende formats en ook maanden en dagen die omdraaien in dezelfde kolommen ondanks dat ik dat format gelijk trek in de code).
Dit heeft gok ik te maken met de scripting.dictionary, maar geen idee hoe ik dit goed krijg.
 
Voeg ze er tussen.
Code: 
x(8) = CLng(ar(j, 8))
x(10)=clng(ar(j,10))

Zet de eigenschap op een datum.
 
HSV,

zou je mij kunnen helpen dit in de code te verwerken? Ik weet niet waar ik dit moet plaatsen. :)

Code: 
    Dim lLastRow1 As Long
    Dim lLastRow11 As Long

    Dim ar As Variant
    Dim ar1 As Variant

    lLastRow1 = Sheets("POs").Cells(Rows.Count, 1).End(xlUp).Row
    lLastRow11 = Sheets("POs").Cells(Rows.Count, 11).End(xlUp).Row

    If lLastRow1 > lLastRow11 Then

        ar1 = Sheets("POs").range("A" & lLastRow11 + 1 & ":N" & lLastRow1)
        ar = Sheets("POs").range("A4:N" & lLastRow11)

        Set d = CreateObject("Scripting.Dictionary")

        For j = 1 To UBound(ar1)
            c00 = ar1(j, 1) & "|" & ar1(j, 2) & "|" & ar1(j, 3) & "|" & ar1(j, 4) & "|" & ar1(j, 5) & "|" & ar1(j, 6) & "|" & ar1(j, 8) & "|" & ar1(j, 10)
            d(c00) = Application.Index(ar1, j, 0)
        Next j

        For j = 1 To UBound(ar)
            c00 = ar(j, 1) & "|" & ar(j, 2) & "|" & ar(j, 3) & "|" & ar(j, 4) & "|" & ar(j, 5) & "|" & ar(j, 6) & "|" & ar(j, 8) & "|" & ar(j, 10)
            If d.Exists(c00) Then
                x = d(c00)
                x(11) = ar(j, 11)
                x(12) = ar(j, 12)
                x(13) = ar(j, 13)
                x(14) = ar(j, 14)
                d(c00) = x
            End If
        Next j
        Sheets("POs").range("A4:N" & lLastRow1).ClearContents
        Sheets("POs").range("A4:N" & 4 + d.Count - 1) = Application.Index(d.items, 0, 0)
    
    Else: MsgBox ("geen nieuwe regels")
       
    End If
 
Als je goed kijkt zie je al een paar x-jes staan met een getal tussen de haakjes.
 
Het werkt, super bedankt!

Hoe kan het dat het aangepast wordt via CLng naar variabel type "long" maar het dan wel als datum herkent wordt? Of is dit te ingewikkeld om uit te leggen. :D
 
Laatst bewerkt:
clng geeft het getal weer van een datum.
15-08-2019 = 43692
 
OK!

Wanneer ik x(13) = CLng(ar(j, 13)) invul wordt voor lege waarden 0-1-1900 ingevuld. Hoe kan ik het format veranderen voor x(13) wanneer deze een waarde bevat?

Code: 
        For j = 1 To UBound(ar)
            c00 = ar(j, 1) & "|" & ar(j, 2) & "|" & ar(j, 3) & "|" & ar(j, 4) & "|" & ar(j, 5) & "|" & ar(j, 6) & "|" & ar(j, 8) & "|" & ar(j, 10)
            If d.Exists(c00) Then
                x = d(c00)
                x(11) = ar(j, 11)
                x(12) = ar(j, 12)
                If Not ar(j, 13) Is Nothing Then x(13) = CLng(ar(j, 13))
                x(14) = ar(j, 14)
                d(c00) = x
 
Code: 
x(11) = ar(j, 11)
      x(12) = ar(j, 12)
[COLOR=#ff0000]        if isdate(ar(j, 13)) then[/COLOR]
[COLOR=#ff0000]           x(13) = clng(ar(j, 13))[/COLOR]
[COLOR=#ff0000]        else[/COLOR]
[COLOR=#ff0000]          x(13) = ar(j, 13)[/COLOR]
[COLOR=#ff0000]        end if[/COLOR]
      x(14) = ar(j, 14)
      d(c00) = x

Kan ook achter elkaar, maar ben ik geen liefhebber van.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan