---

Hej Kandu-Orakel

Jeg sidder med en VBA kode som er alt for langsom, og kunne godt tænke mig noget hjælp til optimering af den.

Koden skal kunne følgende.
Har 3 ark. I første ark er der en masse info, som hele tiden kan opdateres. Lige nu er der vel 1000 rækker og 10 columns.

Dette ark opdateres hver d. 2 i hver måned, så d. 1 tager jeg alt i ark og kopierer over i ark2. Nu har jeg altså to ark med samme info. d. 2 bliver ark1 så opdateret med nye rækker, samt ændringer i nogle af de eksisterende rækker. Det er kun i én bestemt kollone som kan ændres i en en eksisterende række. (kollone 10)

I sheet3 vil jeg gerne have kopieret, alle ændringerne over. (Dvs. nye rækker + rækken hvor i der er en ændring)
I øjeblikket bruger jeg et langt og besværlig loop, til at gennemgå alle rækkerne imellem ark1 og ark2, for at finde ændringerne. Dette gør koden langsom, og den tager ca. 10 min.

Her er mit loop.

If Sheets(1).Cells(a.Row, 1).Value = Sheets(2).Cells(b.Row, 1).Value Then 'Kollone 1
If Sheets(1).Cells(a.Row, 2).Value = Sheets(2).Cells(b.Row, 2).Value Then 'Kollone 2
If Sheets(1).Cells(a.Row, 3).Value = Sheets(2).Cells(b.Row, 3).Value Then 'Kollone 3
....Osv. til kollone 10....
If Sheets(1).Cells(a.Row, 10).Value = Sheets(2).Cells(b.Row, 10).Value Then 'Kollone 10
count = 1 'Hvis de matcher så exit
Exit For
Else 'Hvis de ikke matcher så kopier
a.Copy Destination:=Sheets(3).Cells(r, 1)
Sheets(3).Cells(r, 10) = Sheets(1).Cells(a.Row, 10).Value - Sheets(2).Cells(b.Row, 10).Value 'Pastes the difference to the hours column
Sheets(3).Cells(r, 18) = "Updated - Difference"
r = r + 1
count = 1
Exit For
End If
End If
Next

If count = 0 Then 'Hvis intet er fundet, så har vi en hel ny linje som skal kopieres over i ark 3
a.Copy Destination:=Sheets(3).Cells(r, 1)
r = r + 1
End If
End If
count = 0
Next

Hvordan kan jeg undgå denne lange loop?

---

Hvis jeg har forstået dig ret, så er du ude efter at alle forskelle skal fremgå af Ark3 i de celler hvor forskellen er.

F.eks hvis der er forskel mellem Ark1 og Ark2 i celle A850 så skal værdien af Ark1 celle A850 stå i Ark3 celle A850

I stedet for en indviklet og langsomlig løkke ville jeg lave det om til en formel.

Altså kopiere Ark1 til Ark2 som du gør nu og så i Ark3 ville jeg have følgende formel:
=HVIS(Ark1!A1=Ark2!A1;"";Ark1!A1)
Formlen indsættes i Ark3 Celle A1 --> kopier celle A1 --> marker området A1 til og med J1000 (eller hvor meget du nu har brug for) --> sæt ind

Ark 3 vil nu med det samme vise forskelle mellem Ark1 og Ark2

Ovenstående metode til indsættelse af formel er kun testet i LibreOffice da jeg normalt ikke benytter Microsoft Office.
Sørg for at formlen er på plads inden i begynder at rette

---

Nej, det er ikke helt rigtigt. Hele rækken skal vises

Eksempel.

Ark1: Her står eksempelvis følgende info. (Har lige lavet fed, på forskellene mellem ark1 og ark2.

Navn Alder Timer
Peter 20 2
John 62 5
Ebbe 40 2
Lars 32 4

'
Ark2:
Navn Alder Timer
Peter 20 1
Ebbe 40 2
Lars 32 4

Ark3: Her skal rækkerne hvor der er ændinger så vises
Peter 20 2
John 62 5

---

Ok, det er forstået.
Jeg har lige et bonusspørgsmål, er der en af kolonnerne der er unik, altså en kolonne hvor der ikke kan stå det samme i flere rækker.

F.eks en kolonne med medarbejdernummer eller cpr nummer?

---

Uden at have gået nærmere ind i din kode, vil jeg foreslå dig at indlæse alle dine data i variant-arrays, inden du begynder på dine loops. Det er meget hurtigere for VBA at læse arrays end Excel-celler.

Simon

Dette spørgsmål er blevet annulleret, det er derfor ikke muligt for at tilføje flere kommentarer.