Sammenlign 2 EXCEL ark på flere betingelser

Ingen der har et løsningsforslag?

Nedenstående kode finder kun de der er forskellige men hvis der er ekstra datarækker bliver disse ikke sorteret fra. Hvorfor?

Option Explicit

Sub Find_Ikke_Ens_I_Ark()
Dim F, C, T, U, A As Integer, Q As Boolean
Application.ScreenUpdating = False
A = 2

Worksheets("FI Data").Activate
F = ActiveCell.SpecialCells(xlLastCell).Row ' Finder ud af hvor mange rækker der er med data på ark1

Worksheets("Project Data").Activate
U = ActiveCell.SpecialCells(xlLastCell).Row ' Finder ud af hvor mange rækker der er med data på ark2

For C = 2 To U
Q = True
For T = 2 To F
Worksheets("Project Data").Activate
If Worksheets("Project Data").Cells(T, 17) = Worksheets("FI Data").Cells(C, 2) _
And Worksheets("Project Data").Cells(T, 13) = Worksheets("FI Data").Cells(C, 9) Then
Q = False
GoTo Skift
End If


Next T

Skift:
If Q = True Then
    Sheets("FI Data").Select
    Rows(T & ":" & T).Select
    Selection.Cut
    Sheets("FI diff from CO").Select
    Rows(A & ":" & A).Select
    ActiveSheet.Paste
    A = A + 1
    Q = False
    Application.CutCopyMode = False
  End If
'  Sheets("FI DATA").Select
'  If Range("A" & T) <> "" Then
'  Else
'  Range("A" & T).EntireRow.Delete xlUp
'  End If
Next C
Sheets("FI diff from CO").Select
Application.ScreenUpdating = True
Application.CutCopyMode = False
Range("A1").Select
End Sub



Sub Find_Ik_Ens_I_Ark()
Dim F, C, T, U, A As Integer, Q As Boolean
Application.ScreenUpdating = False
A = 2

Worksheets("FI Data").Activate
F = ActiveCell.SpecialCells(xlLastCell).Row ' Finder ud af hvor mange rækker der er med data på ark1

Worksheets("Project Data").Activate
U = ActiveCell.SpecialCells(xlLastCell).Row ' Finder ud af hvor mange rækker der er med data på ark2

For T = 2 To F
Q = True
For C = 2 To U
Worksheets("Project Data").Activate
If Worksheets("Project Data").Cells(T, 17) = Worksheets("FI Data").Cells(C, 2) _
And Worksheets("Project Data").Cells(T, 13) = Worksheets("FI Data").Cells(C, 9) Then
Q = False
GoTo Skift
End If


Next C

Skift:
If Q = True Then
    Sheets("Project Data").Select
    Rows(T & ":" & T).Select
    Selection.Cut
    Sheets("CO diff from FI").Select
    Rows(A & ":" & A).Select
    ActiveSheet.Paste
    A = A + 1
    Q = False
    Application.CutCopyMode = False
  End If
'  Sheets("Project Data").Select
'  If Range("A" & T) <> "" Then
'  Else
'  Range("A" & T).EntireRow.Delete xlUp
'  End If
Next T
Sheets("CO diff from FI").Select
Application.ScreenUpdating = True
Application.CutCopyMode = False
Range("A1").Select
End Sub

prøv at teste, jeg er ikke helt klar over om det er det du ønsker.
Koden er tunet, så jeg kan ikke lave den hurtigere.

Option Explicit
Option Base 1    ' alle variabler starter ved 1

Sub Find_Ikke_Ens_I_Ark()
    Dim F, C, T, U, A As Integer, RW As Long
    Dim ProjectData As Variant, FIData As Variant
    Dim FIFind As String, PRFind As String
    Dim PR() As Variant, FI As Variant, CO As Integer
    Application.ScreenUpdating = False


    FIData = Worksheets("FI Data").Range("A1").CurrentRegion
    ProjectData = Worksheets("Project Data").Range("A1").CurrentRegion
    ReDim PR(UBound(ProjectData, 1))
    ReDim FI(UBound(FIData, 1))
    'Worksheets("Project Data").Cells(T, 17) = Worksheets("FI Data").Cells(C, 2) _
    'Worksheets("Project Data").Cells(T, 13) = Worksheets("FI Data").Cells(C, 9) Then
    For C = 2 To UBound(FIData, 1)
        FIFind = FIData(C, 2) & FIData(C, 9)    ' kopler de to celler fra "FI Data" sammen i en strengvariabel

        For T = 2 To UBound(ProjectData, 1)
            PRFind = ProjectData(T, 17) & ProjectData(T, 13)    ' kopler de to celler fra "Project Data" sammen i en strengvariabel

            If PRFind = FIFind Then
                FI(C) = "ENS"
                PR(T) = "ENS"
                Exit For
            Else
                If PR(T) <> "ENS" Then PR(T) = Empty
            End If
        Next T
    Next C


    ' overfører de rækker fra "FI Data" der ikke var en makker til i "Project Data" til "FI diff from CO"
    A = 2
    For C = 2 To UBound(FIData, 1)
        If IsEmpty(FI(C)) Then
            For T = 1 To UBound(FIData, 2)
                Sheets("FI diff from CO").Cells(A, T) = FIData(C, T)
                FIData(C, T) = Empty
            Next
            A = A + 1
        End If
    Next
    ' overfører de rækker fra "Project Data" der ikke var en makker til i "FI Data" til "CO diff from FI"

    A = 2
    For T = 2 To UBound(ProjectData, 1)
        If IsEmpty(PR(T)) Then
            For C = 1 To UBound(ProjectData, 2)
                Sheets("CO diff from FI").Cells(A, C) = ProjectData(T, C)
                ProjectData(T, C) = Empty
            Next
            A = A + 1
        End If
    Next
    'Skriver tilbage til arket"Project data", uden dem der ikke var ens
    RW = Worksheets("Project Data").Range("A1").CurrentRegion.Rows.Count
    CO = Worksheets("Project Data").Range("A1").CurrentRegion.Columns.Count
    Worksheets("Project Data").Range("A1").CurrentRegion = ProjectData
    'Sortering
    Worksheets("Project Data").Select
    Range(Cells(1, 1), Cells(RW, CO)).Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal

    'Skriver tilbage til arket"FI Data", uden dem der ikke var ens
    RW = Worksheets("FI Data").Range("A1").CurrentRegion.Rows.Count
    CO = Worksheets("FI Data").Range("A1").CurrentRegion.Columns.Count
    Worksheets("FI Data").Range("A1").CurrentRegion = FIData
    'Sortering
    Worksheets("FI Data").Select
    Range(Cells(1, 1), Cells(RW, CO)).Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal

    Sheets("FI diff from CO").Select
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub

Tager den højde for overskrifter i første række?

Jeg kan sende dig filen. Lige nu kopiere den alle dataene fra de to ark til to nye ark. Det ser ikke ud til den sammenligner rækkerne pga. af de to betingelser.

Det den skal er på baggrund af de to betingelser:

Sammenligne arkene ("FI DATA" og "Project DATA")

Find ens værdier i FI Data og Project Data og kopiere dem over i hver sit ark "FI diff" fra "FI DATA" ens med "CO diff" fra "PROJECT DATA".

Aaarh, det ser dælme godt ud.. Har fået den til at virke (Skulle lige korrigere en kolonne), så nu skal den køres gennem på det store ark.. 

Super tak for den hurtige hjælp.

Hvordan går det, kører koden som den skal ??

Det gik udemærket, den løste opgaven 99%. Der var en mindre mismatch men uden betydning i den total opgørelse.

Var dog nød til at splitte datasættet op og køre koden 3 gange, da der opstod en overload omkring linie 32.000.