Blad met 2 lijsten vergelijken via macro

[Peekhamer]

ik heb een bestand waarvan uitvoer uit twee programma's staat. Deze laat ik via macro samen op 1 werkblad uitkomen zodat ik twee lijsten naast elkaar krijg.
Voor het makkelijk overzichtelijke vergelijken wil ik de twee lijsten naast elkaar hebben staan. Nu kan het echter zo zijn dat een nummer wel op de ene maar niet op de andere lijst voorkomt. Dit kan allebei de kanten op. In dat geval wil ik wil de rij in de andere lijst een regel naar beneden op laten schuiven. Ook zijn er per nummer meerdere mogelijkheden mogelijk.
Zie bijgevoegd voorbeeld.

Ik loop vast in het laten "nivelleren" van de lijst. Kan iemand me helpen?

Als ik niet duidelijk ben geweest; laat het weten!

EDIT: titel even aangepast!

 

[Peekhamer]

geen suggesties? of ben ik niet duidelijk genoeg?

 

[Peekhamer]

is er echt niemand die me hiermee kan helpen of ben ik echt niet duidelijk?

 

[Peekhamer]

bump!!

 

[Elsendoorn2134]

Gebruik een draaitabel.

Peekhamer,

Waarom gebruik je geen draaitabel om de twee naast elkaar te maken?
Veel makkelijker en verschillen zijn direct zichtbaar.

Veel Succes.

Bekijk bijlage Helpmij_vb(FE).xlsx

 

[Peekhamer]

Bedankt voor de suggestie, hij is ook duidelijk maar heb toch voorkeur voor het in 1 oogopslag kunnen zien.
Ik heb een duidelijker voorbeeld gemaakt; met een beschrijving hoe het volgens mij zou werken.
Ik kom dichterbij, ben alleen niet zo goed in loops en do whiles enzo.

Kan iemand eens in dit bestandje kijken:?

Bekijk bijlage VB_helpmij_versie 2.xlsx

 

[Elsendoorn2134]

VBA macro voor vergelijken lijsten

Peekhamer,

Hierbij de macro waarbij je de lijst die je opstuurde kan vergelijken.

Public Sub VergelijkLijsten()
'wat wil ik dat macro doet:
'* voer A2 - G2 uit en plaats resultaat in N2.
'* rest > 0? Voeg op huidig regelnr kol A : kol E  in; shiftDown
'* rest < 0? Voeg op huidig regelnr klo G : kol L in; shiftDown
'* offset 1 cel naar beneden
'* voer P3 - Q3 uit en plaats resultaat in R3.
'* rest > 0? Voeg op huidig regelnr kol A : kol E  in; shiftDown
'* rest < 0? Voeg op huidig regelnr kol G : kol L in; shiftDown
'* loop totdat alle nrs in P gebruikt zijn.
'* daarna kolom N clearcontents.

Dim lResultaat As Long

Sheets("Data").Range("N2").Select

Do While ActiveCell.Offset(0, -13) <> ""

    ActiveCell = ActiveCell.Offset(0, -13) - ActiveCell.Offset(0, -7)

    If ActiveCell > 0 Then
        Range(ActiveCell.Offset(0, -13).Address & ":" & ActiveCell.Offset(0, -9).Address).Insert _
            Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ElseIf ActiveCell < 0 Then
        Range(ActiveCell.Offset(0, -7).Address & ":" & ActiveCell.Offset(0, -3).Address).Insert _
            Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
    ActiveCell.Offset(1, 0).Select
Loop

MsgBox "Lijsten zijn vergeleken.", vbInformation, "Klaar"

End Sub

Wat je precies met de lijsten in kolom P en Q wil begrijp ik niet want deze waren niet gevuld.

Veel Succes.

Bekijk bijlage HelpmijVergelijken.xlsm

 

[Peekhamer]

Thanx Elsendoorn!

Ja die verwijzing was idd niet goed. Eerder had ik kolom A en kolom G nogmaals gekopieerd naar resp P en Q voor gemakkelijker overzicht. Later aangepast alleen niet alles blijkbaar.

Ik ga hem straks even testen!!

 

[Peekhamer]

Ik ben nog wat aan het stoeien, probeer nu nadat de cellen zijn ingevoegd om dan het registratienummer dat ontbreekt erin te kopieren. Alleen werkt "paste vd waarde" niet. Dit komt waarschijnlijk omdat dit binnen de "If" valt?? wil iemand me dat uitleggen en laten zien hoe het dan wel moet?
Alvast bedankt weer!

Dim lResultaat As Long
    Sheets("Aansluiting").Range("N2").Select
    Do While ActiveCell.Offset(0, -13) <> ""
    ActiveCell = ActiveCell.Offset(0, -13) - ActiveCell.Offset(0, -7)
    If ActiveCell > 0 Then
        Range(ActiveCell.Offset(0, -13).Address & ":" & ActiveCell.Offset(0, -9).Address).Insert _
            Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'''' nieuw stukje code        
        ActiveCell.Offset(, -7).Copy
        Range("A1").End(xlDown).Offset(1, 0).Activate '' dat heb ik zo gedaan omdat ActiveCell.Offset(,-13).paste niet werkte...
        ActiveCell.Paste
        Application.CutCopyMode = False

(....even alleen het relevante stukje gekopieerd er is ook nog elseif etc.)

Als ik de macro run en ik wil dit neit "zien", dan moet ik "screenupdating" op false zetten toch? lijkt me dat ie dan ook sneller runt? Maar een progressbar zou dan wel fijn zijn. daar ga ik dan ook eens naar zoeken.

 

[Peekhamer]

Hebt trouwens die "dim Lresultaat as Long" eruit gegooid, die doet niks volgens mij?? IIg werkt het zonder ook?

Door toevoegen van dit stukje code

ActiveCell.Offset(, -15).Value = ActiveCell.Offset(, -8).Value

en andersom bij de elseif voegt ie tegelijk het ontbrekende nummer toe.

En idd, screenupdating=false zorgt ervoor dat de macro een stuk sneller gaat.

Opgelost en bedankt voor de hulp.

En nu weer verder bouwen

 

[Elsendoorn2134]

Aangepaste versie VBA

Peekhamer,

Ik vermoed dat je onderstaande aanpassing bedoeld.

Public Sub VergelijkLijsten()
'wat wil ik dat macro doet:
'* voer A2 - G2 uit en plaats resultaat in N2.
'* rest > 0? Voeg op huidig regelnr kol A : kol E  in; shiftDown
'* rest < 0? Voeg op huidig regelnr klo G : kol L in; shiftDown
'* offset 1 cel naar beneden
'* voer P3 - Q3 uit en plaats resultaat in R3.
'* rest > 0? Voeg op huidig regelnr kol A : kol E  in; shiftDown
'* rest < 0? Voeg op huidig regelnr kol G : kol L in; shiftDown
'* loop totdat alle nrs in P gebruikt zijn.
'* daarna kolom N clearcontents.

Application.ScreenUpdating = False

Sheets("Data").Range("N2").Select

Do While ActiveCell.Offset(0, -13) <> ""

    ActiveCell = ActiveCell.Offset(0, -13) - ActiveCell.Offset(0, -7)

    If ActiveCell > 0 Then
        Range(ActiveCell.Offset(0, -13).Address & ":" & ActiveCell.Offset(0, -9).Address).Insert _
            Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveCell.Offset(0, -13) = ActiveCell.Offset(0, -7)
    ElseIf ActiveCell < 0 Then
        Range(ActiveCell.Offset(0, -7).Address & ":" & ActiveCell.Offset(0, -3).Address).Insert _
            Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveCell.Offset(0, -7) = ActiveCell.Offset(0, -13)
    End If
    ActiveCell.Offset(1, 0).Select
Loop

Application.ScreenUpdating = True

MsgBox "Lijsten zijn vergeleken.", vbInformation, "Klaar"

End Sub

Veel Succes.