Sammenlign ark ---- foreslag

Er det kun en kolonne pr. liste der skal sammenlignes ?

Flemming Dahl har faktisk et produkt beregnet lige til dette, men det koster nok lidt. :-) Se hans demo.
http://www.win-consult.com/SmartOffice/Produkter/Compare2Column.asp

Nej det er ca. 6 kolonner som kan varier lidt på den ene liste ... dog vil der altid være police nr. i B:B

kigger på det :o)

Kig også lige på makroen her - den er gratis :-)
http://www.erlandsendata.no/english/vba/ws/comparews.htm

bak >> Det er super smart det Flemming har udviklet men det bliver lidt for teknisk .... med installation osv. !

slo >> det er da en marko jeg lige vil prøve at arbejde vidre med :o)

slo >> den makro du linker til .... kan desværre heller ikke bruges, jeg kan ikke rigtig læse makroen da jeg ikke er så stiv til dem .... men det ser ud til den sammenligner celle for celle .... hvis de to celler er ens bliver den nye celle tom og hvis de ikke er ens bliver der skrevet begge resultater i den nye celle adskilt af <> .... den tager ikke højde for om en anden celler i arket også hedder det samme

det du søger er det modsatte af denne

http://www.eksperten.dk/spm/315833

kan du ikke lave den om

Jo ... det ligner noget af det rigtige ..... jeg skal bare have alle dem er ikke finde begger steder

+ jeg vil have resultaterne skilt ad .... det vil sige at på ark3 vil jeg have en liste over dem på ark1 der ikke er på ark2 !

det skal IKKE være så den at den nye liste på ark3 er en liste over dem der ikke er på ark2 og ikke er på ark1 (hvis i forstår)

hmm ... jeg kommer vist til at springe nogle bogstaer over ind imellem .... håber i kan læse det aligevel

kabbak >> vil du prøve at skrive en makro til mig ??

jeg prøver

Tak

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

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

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

For T = 1 To F
Q = True
For C = 1 To U
Worksheets("Ark1").Activate
If Worksheets("Ark1").Cells(T, 2) = Worksheets("Ark2").Cells(C, 2) Then
Q = False
End If

Next C

If Q = True Then
    Sheets("Ark1").Select
    Rows(T & ":" & T).Select
    Selection.Copy
    Sheets("Ark3").Select
    Rows(A & ":" & A).Select
    ActiveSheet.Paste
    A = A + 1
    Q = False
    Application.CutCopyMode = False
  End If
Next T
Sheets("Ark3").Select
Application.ScreenUpdating = True
Application.CutCopyMode = False
Range("A1").Select
End Sub

sammenligner kun kolonne B i Ark1 og Ark2

kabbak >> meget lidt redigering og den virker perfekt

Mange tak

If Worksheets("Ark1").Cells(T, 2) = Worksheets("Ark2").Cells(C, 2) Then
Q = False
GoTo Skift ' indsæt denne linie
End If

Next C
Skift: ' og indsæt også denne linie
If Q = True Then

hej indsæt lige de 2 linier hvor skift indgår, så kører det hurtigere

resultat

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

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

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

For T = 1 To F
Q = True
For C = 1 To U
Worksheets("Nyliste").Activate
If Worksheets("NyListe").Cells(T, 2) = Worksheets("Fastliste").Cells(C, 2) Then
Q = False
GoTo Skift
End If

Next C

Skift:
If Q = True Then
    Sheets("Nyliste").Select
    Rows(T & ":" & T).Select
    Selection.Copy
    Sheets("ResultatListe").Select
    Rows(A & ":" & A).Select
    ActiveSheet.Paste
    A = A + 1
    Q = False
    Application.CutCopyMode = False
  End If
Next T
Sheets("ResultatListe").Select
Application.ScreenUpdating = True
Application.CutCopyMode = False
Range("A1").Select
End Sub

yes

Mange tak

den funkede eller fint .... hvorfor ændre den ?

når den finder en der er ens, behøver den jo ikke at teste mere med den celle, og så kan den jo godt hoppe ud af sammenligningen og gå videre til den næste.

OK ... tak ... det også som om den er blevet lidt hurtigere :o)

Ok ved det er et mega gammelt spørgsmål - jeg har fået brug dette igen og kan nu ikke huske hvordan man får det til at funke.

Har kaldt mine ark "NyListe" "FastListe" og "ResultatListe"
Har copy/paste makro ind i et modul

hvad så ?

-----------------------------
Sub Init_Compare()
'''Dim af variable
    Dim TB1 As Range, TB2 As Range, TB3 As Range, TB4 As Range
    Dim Temp As Range
    Dim IndexCol1 As Long, IndexCol2 As Long
    Dim StartTid As Double
    Dim ReturnArray As Variant
   
    Set TB1 = Sheets("NyListe").Range("A1:H1") '1. inputområde
    Set TB2 = Sheets("FastListe").Range("A1:H1") '2. inputområde
   
    Set TB3 = Sheets("ResultatListe").Range("A1")    '1. outputområde
    Set TB4 = Sheets("ResultatListe").Range("A1")    '2. outputområde
    IndexCol1 = 2  'anden kolonne i TB1 (B)
    IndexCol2 = 2  'anden kolonne i TB2 (B)
   
    StartTid = Timer
   
    DoCompare2Lists TB1, TB2, IndexCol1, IndexCol2, ReturnArray
    Set TB3 = TB3.Resize(UBound(ReturnArray, 1), UBound(ReturnArray, 2))
    TB3 = ReturnArray
   
    DoCompare2Lists TB2, TB1, IndexCol2, IndexCol1, ReturnArray
    Set TB4 = TB4.Resize(UBound(ReturnArray, 1), UBound(ReturnArray, 2))
    TB4 = ReturnArray
   
    Set ReturnArray = Nothing
    Application.ScreenUpdating = True
    MsgBox "Færdig  tid : " & Timer - StartTid
    Sheets("ResultatListe").Select
End Sub

Sub DoCompare2Lists(WS1 As Range, WS2 As Range, SearchCol1 As Long, SearchCol2 As Long, aForskel As Variant)
  Dim xCol As Scripting.Dictionary
  Dim Fundet As Boolean, Last1 As Long, Last2 As Long
  Dim Cols2 As Long
  Dim i As Long, z As Long, x As Long
 
  Set xCol = New Scripting.Dictionary
  Cols2 = WS2.Columns.Count
  Last1 = WS1.Cells(65536, SearchCol1).End(xlUp).Row
  Last2 = WS2.Cells(65536, SearchCol2).End(xlUp).Row
  ReDim aForskel(Last2, Cols2)
  z = 0
 
  On Error Resume Next
  With WS1
      For i = 1 To Last1
        xCol.Add Item:=CStr(.Cells(i, SearchCol1)), Key:=CStr(.Cells(i, SearchCol1))
      Next
  End With
  With WS2
      For i = 1 To Last2
        Fundet = xCol.Exists(CStr(.Cells(i, SearchCol2)))
        If Not Fundet = True Then
            z = z + 1
            For x = 1 To Cols2
              aForskel(z, x) = .Cells(i, x)
            Next
        End If
        Fundet = True
      Next
  End With
  Set xCol = Nothing
End Sub