Vergelijking met meerdere kolommen

[HSV]

Eerst de kolommen van alle bladen op standaard, daarna op datumformaat.

Sub tsh()
    Dim Br
    Dim i As Long
    Dim Sl As String
   [COLOR=#FF0000] Dim sh[/COLOR][COLOR=#ff0000]
    Dim Ws As Worksheet
    For Each sh In Sheets(Array("Blad1", "blad2", "Blad3", "Blad4"))
     Set Ws = sh
      With Ws.Columns("L")
       .NumberFormat = "general"
       .Offset(, 4).NumberFormat = "general"
      End With
    Next sh[/COLOR]
    With CreateObject("Scripting.Dictionary")
        Br = Sheets("Blad1").Cells(1).CurrentRegion
        For i = 2 To UBound(Br)
            .Item(Join(Array(Br(i, 1), Br(i, 2), Br(i, 3)), "|")) = Application.Index(Br, i, [Column(A:R)])
        Next
        Br = Sheets("Blad2").Cells(1).CurrentRegion
        For i = 2 To UBound(Br)
            Sl = Join(Array(Br(i, 1), Br(i, 2), Br(i, 3)), "|")
            If .Exists(Sl) Then
                .Remove Sl
            Else
                Sheets("Blad4").Range("A" & Sheets("Blad4").Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(, 18) = _
                    Application.Index(Br, i, [Column(A:R)])
            End If
        Next
        Sheets("Blad3").Cells(2, 1).Resize(.Count, 18) = Application.Index(.Items, 0)
    End With
    [COLOR=#ff0000]For Each sh In Sheets(Array("Blad1", "Blad2", "Blad3", "Blad4"))
    Set Ws = sh
      With Ws.Columns("L")
         .NumberFormat = "dd-mm-yyyy"
         .Offset(, 4).NumberFormat = "dd-mm-yyyy"
      End With
    Next sh[/COLOR]
End Sub

 

[Phill]

Het werkt nu prima.
Heb ik nog even vraagje:
Zowel blad 1 als blad 2 bevatten ongeveer een 8000 regels.
De macro doet er ongeveer 10 minuten over voordat hij alles doorlopen heeft. Kan dit vlugger?

 

[Timshel]

Deze bewerking:

Application.Index(Br, i, [Column(A:R)])

is enigszins traag.
Het kan schelen om die te vervangen:

Sub tsh()
    Dim Br
    Dim i As Long
    Dim Sl As String
    Dim Sh
    Dim Ws As Worksheet
    
    For Each Sh In Sheets(Array("Blad1", "blad2", "Blad3", "Blad4"))
        Set Ws = Sh
        With Ws.Columns("L")
            .NumberFormat = "general"
            .Offset(, 4).NumberFormat = "general"
        End With
    Next Sh
    
    With CreateObject("Scripting.Dictionary")
        Br = Sheets("Blad1").Cells(1).CurrentRegion
        For i = 2 To UBound(Br)
            .Item(Join(Array(Br(i, 1), Br(i, 2), Br(i, 3)), "|")) = [COLOR="#FF0000"]Array(Br(i, 1), Br(i, 2), Br(i, 3), Br(i, 4), Br(i, 5), _
                Br(i, 6), Br(i, 7), Br(i, 8), Br(i, 9), Br(i, 10), Br(i, 11), Br(i, 12), Br(i, 13), Br(i, 14), Br(i, 15), _
                Br(i, 16), Br(i, 17), Br(i, 18))[/COLOR]
        Next
        Br = Sheets("Blad2").Cells(1).CurrentRegion
        For i = 2 To UBound(Br)
            Sl = Join(Array(Br(i, 1), Br(i, 2), Br(i, 3)), "|")
            If .Exists(Sl) Then
                .Remove Sl
            Else
                Sheets("Blad4").Range("A" & Sheets("Blad4").Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(, 18) = _
                    [COLOR="#FF0000"]Array(Br(i, 1), Br(i, 2), Br(i, 3), Br(i, 4), Br(i, 5), Br(i, 6), Br(i, 7), Br(i, 8), Br(i, 9), Br(i, 10), _
                    Br(i, 11), Br(i, 12), Br(i, 13), Br(i, 14), Br(i, 15), Br(i, 16), Br(i, 17), Br(i, 18))[/COLOR]
            End If
        Next
        Sheets("Blad3").Cells(2, 1).Resize(.Count, 18) = Application.Index(.Items, 0)
    End With
    
    For Each Sh In Sheets(Array("Blad1", "Blad2", "Blad3", "Blad4"))
        Set Ws = Sh
        With Ws.Columns("L")
            .NumberFormat = "dd-mm-yyyy"
            .Offset(, 4).NumberFormat = "dd-mm-yyyy"
        End With
    Next Sh
End Sub

Nog steeds worden er 8000^2 is 16.000.000 regels met elkaar vergeleken. Dat kost tijd.

 

[HSV]

Zet ook nog eens de 'application.screenupdating = false' bij in het begin van de code.

Ps: als je alles in een array gooit wat iets sneller is dan de dictionary kunnen mijn rode coderegels er denk ik ook wel weer uit.

 

[snb]

Mij lijkt de opmaak van de werkbladen niet van belang.
De beperking van het aantal schrijfakties wel:
In dit geval is application.screenupdating=false dan ook overbodig.

Sub M_snb()
  Set dict4 = CreateObject("Scripting.Dictionary")
    
  With CreateObject("Scripting.Dictionary")

    sn = Sheets("Blad1").Cells(1).CurrentRegion
    For j = 2 To UBound(sn)
      c00 = sn(j, 1) & sn(j, 2) & sn(j, 3) & sn(j, 4)
      .Item(c00) = c00 & sn(j, 5) & sn(j, 6) & sn(j, 7) & sn(j, 8) & sn(j, 9) & sn(j, 10) & sn(j, 11) & sn(j, 12) & sn(j, 13) & sn(j, 14) & sn(j, 15) & sn(j, 16) & sn(j, 17) & sn(j, 18)
    Next
        
    sn = Sheets("Blad2").Cells(1).CurrentRegion
    For j = 2 To UBound(sn)
      c00 = sn(j, 1) & sn(j, 2) & sn(j, 3) & sn(j, 4)
      If .Exists(c00) Then
        .Remove c00
      Else
        dict4.Item(c00) = c00 & sn(j, 5) & sn(j, 6) & sn(j, 7) & sn(j, 8) & sn(j, 9) & sn(j, 10) & sn(j, 11) & sn(j, 12) & sn(j, 13) & sn(j, 14) & sn(j, 15) & sn(j, 16) & sn(j, 17) & sn(j, 18)
      End If
    Next

    Sheets("Blad3").Cells(2, 1).Resize(.Count) = Application.Transpose(.items)
  End With
    
  Sheets("Blad4").Cells(2, 1).Resize(dict4.Count) = Application.Transpose(dict4.items)
End Sub

 

[Phill]

De code van Timshel werkt prima. Tussen de 5 en 10 seconden. Geweldig!!!
Bij deze iedereen bedankt voor de reacties.