Kolommen vergelijken en ontbrekende gegevens plaatsen

[Robert Smidt]

Dag Allen,

Ik ben op zoek naar een macro waar ik twee sheets met elkaar vergelijk.

Het is mijn bedoeling wanneer data (naam) in kolom A van blad 2 niet voorkomt maar wel in kolom A van blad 1, dat deze regel gekopieerd wordt naar blad 1. Echter is de volgorde van de kolommen niet identiek en bovendien hoef ik niet alle data vanuit die regel gekopieerd te hebben naar blad2. Voorts is de kolomindeling - op kolom A na -ook niet juist en zal ook gewijzigd moeten worden.

Het voorbeeld dat ik doe toekomen werkt voor een deel, echter pakt deze alleen de data van kolom A en neemt deze de rest niet mee. Bovendien is het mijn wens wanneer er data in blad 1 staat en niet voorkomt in blad 2 deze i.p.v. de data onderaan zet, boven aan plaatst op de tweede rij (eerste rij is kolomhoofd)Bekijk bijlage test.xlsm.

 

[HSV]

Iets andere indeling om de boel te vergemakkelijken.

Sub test()
    With Sheets("Blad2")
        sq = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    End With
    For j = 1 To UBound(sq)
        sn = sn & "|" & sq(j, 1)
    Next
    For Each cl In Sheets("Blad1").Range("A3:a" & Sheets("Blad1").Cells(Rows.Count, 1).End(xlUp).Row)
            If InStr(sn, cl) = 0 Then
                With Sheets("Blad2")
                 .Range("A2").EntireRow.Insert
                 .Range("A2").Resize(, 4) = cl.Resize(, 4).Value
                 .Range("A2").Resize(, 4).Interior.ColorIndex = xlNone
                End With
             End If
        Next
End Sub

 

[Robert Smidt]

werkt net niet helemaal goed

Bedankt Harry,

Helaas is dit niet helemaal wat ik bedoel, ik mis nl. een onderdeel. Op blad 1 staat een ander kolomvolgorde dan op blad 2. Het is de bedoeling dat hij de volgorde op blad 1 in stand laat en data in de juiste kolommen zet op blad 2, dan werkt het helemaal perfect, nogmaals mijn hartelijke dank daarvoor. Trouwens de belijning hoeft hij niet mee te nemen, ik had dat gedaan om het bereik aan te geven. Het origineel waar ik straks mee ga werken zit ook geen belijning, maar wel fijn dat je het er bij hebt gezet, want dan kan ik dat voor de toekomst goed gebruiken.

Ik ga deze macro gebruiken voor een ander bestand met veel meer kolommen, als ik weet welke regel(s) er verantwoordelijk voor zijn kan ik zelf de macro aanpassen.

Groeten, Robert

 

[HSV]

Sub test()
    With Sheets("Blad2")
        sq = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    End With
    For j = 1 To UBound(sq)
        sn = sn & "|" & sq(j, 1)
    Next
    For Each cl In Sheets("Blad1").Range("A2:a" & Sheets("Blad1").Cells(Rows.Count, 1).End(xlUp).Row)
            If InStr(sn, cl) = 0 Then
                With Sheets("Blad2")
                 .Range("A2").EntireRow.Insert
                 .Range("A2") = cl
                 .Range("B2") = cl.Offset(, 3)
                 .Range("A2").Offset(, 2).Resize(, 2) = cl.Offset(, 1).Resize(, 2).Value
             With .Range("A2").Resize(, 4)
                   .Interior.ColorIndex = xlNone
                   .Borders(xlEdgeLeft).LineStyle = xlNone
                   .Borders(xlEdgeTop).LineStyle = xlNone
                   .Borders(xlEdgeBottom).LineStyle = xlNone
                   .Borders(xlEdgeRight).LineStyle = xlNone
             End With
          End With
      End If
   Next
End Sub

 

[Robert Smidt]

bijna goed

Bedankt Harry,

Hij doet het bijna goed, alleen zet hij de gegevens in de verkeerde kolom, maar ik probeer morgen of ik hier uit kom en zal dan de de vraag op "opgelost" zetten.

Nogmaals hartelijk bedankt voor jouw hulp.

Groeten, Robert

 

[HSV]

Erg lastig, alles door elkaar.

Sub test()
    With Sheets("Blad2")
        sq = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    End With
    For j = 1 To UBound(sq)
        sn = sn & "|" & sq(j, 1)
    Next
    For Each cl In Sheets("Blad1").Range("A2:a" & Sheets("Blad1").Cells(Rows.Count, 1).End(xlUp).Row)
            If InStr(sn, cl) = 0 Then
                With Sheets("Blad2")
                 .Range("A2").EntireRow.Insert
                 .Range("A2") = cl
                 .Range("B2") = cl.Offset(, 3)
                 .Range("C2") = cl.Offset(, 2)
                 .Range("D2") = cl.Offset(, 1)
             With .Range("A2").Resize(, 4)
                   .Interior.ColorIndex = xlNone
                   .Borders(xlEdgeLeft).LineStyle = xlNone
                   .Borders(xlEdgeTop).LineStyle = xlNone
                   .Borders(xlEdgeBottom).LineStyle = xlNone
                   .Borders(xlEdgeRight).LineStyle = xlNone
             End With
          End With
      End If
   Next
End Sub

 

[Robert Smidt]

gaat nog niet goed

Ten eerst bedankt voor de moeite en de tijd, helaas werkt het nog steeds niet naar behoren.

Het is mij ook niet helemaal duidelijk wat de code doet. Zo ver ik het begrijp gaat hij eerst de regel overzetten en gaat dan schuiven met de gegevens. Volgens mij gaat daar iets niet goed, want wanneer je een geven verplaatst ga je ander gegeven overschrijven en ben je dus minimaal 1 gegeven kwijt. Nu blijkt uit jouw code dat er niks kwijt is, maar de volgorde is ook nog steeds niet juist. Zou het niet beter zijn dat hij de data één-voor-één overtankt vanuit blad1?

Als je er nog even naar wilt kijken en misschien kun je achter de regel een kleine uitleg geven wat het systeem nu doet en dan m.n. het schuiven van data is mij niet helder.

Alvast weer hartelijk bedankt.

 

[HSV]

Dat kwam omdat ik blad 1 de eerste keer ook had veranderd, maar bij de aanpassing niet meer was opgemerkt.

Sub test()
    With Sheets("Blad2")
        sq = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    End With
    For j = 1 To UBound(sq)
        sn = sn & "|" & sq(j, 1)
    Next
    For Each cl In Sheets("Blad1").Range("A2:a" & Sheets("Blad1").Cells(Rows.Count, 1).End(xlUp).Row)
            If InStr(sn, cl) = 0 Then
                With Sheets("Blad2")
                 .Range("A2").EntireRow.Insert
                 .Range("A2") = cl
                 .Range("B2").Resize(, 2) = cl.Offset(, 2).Resize(, 2).Value
                 .Range("D2") = cl.Offset(, 1)
             With .Range("A2").Resize(, 4)
                   .Interior.ColorIndex = xlNone
                   .Borders(xlEdgeLeft).LineStyle = xlNone
                   .Borders(xlEdgeTop).LineStyle = xlNone
                   .Borders(xlEdgeBottom).LineStyle = xlNone
                   .Borders(xlEdgeRight).LineStyle = xlNone
             End With
          End With
      End If
   Next
End Sub

 

[Robert Smidt]

Super, het werkt

echter had ik graag een uitleg willen hebben wat onderstaande code precies doet, dan begrijp ik het ook beter en kan ik eeder mijn eigen problemen oplossen.

  .Range("A2") = cl
  .Range("B2").Resize(, 2) = cl.Offset(, 2).Resize(, 2).Value
  .Range("D2") = cl.Offset(, 1)
With .Range("A2").Resize(, 4)

Nogmaal heel erg bedankt, je hebt me enorm geholpen.

 

[HSV]

.Range("A2") = cl 'cl = gezochte naam.
.Range("B2").Resize(, 2) = cl.Offset(, 2).Resize(, 2).Value 'B2 & c2 = 2 kolommen naar rechts van cl en dan de twee waarden daar rechts van.
.Range("D2") = cl.Offset(, 1) 'D2 = 1 kolom rechts van cl.
With .Range("A2").Resize(, 4) 'A2 & B2 & C2 & D2

 

[Robert Smidt]

Laatste bericht

Harry,

Je hebt me ontzettend geholpen en zal me de komede tijd nog even op de uitleg van jou storten. In eerste instantie ontbreekt het mij aan de logica, maar wanneer ik me hier op ga storten denk ik de logica zeker te vinden zodat ik in de toekomst dergelijke situaties zelf kan bedenken.

Nogmaals hartelijk bedankt.

Groeten, Robert