27. januar 2007 - 11:18Der er
4 kommentarer og 1 løsning
Sammenligning af to filer
Hej Expert, jeg har tidligere anvendt en macro, der kan sammenligne to excelark i Excel, jf. nedenstående. Her viser den gule felter, hvor der er forskel i arkene. Hvordan kan jeg lave en makro, der kan sammenligne to FILER i stedet, hvor der markeres med en farve, hvor der er forskelle i filerne?
Sub SammenlignArk() ST = Now() Dim AD As String, FArk As Variant, Sammenlign As Variant, i As Long, K As Integer, N As Integer
Sheets("Ark1").Cells.Interior.ColorIndex = xlNone Sheets("Ark2").Cells.Interior.ColorIndex = xlNone AD = Sheets("Ark1").Range("A1").SpecialCells(xlLastCell).Address K = Sheets("Ark1").Range("A1").SpecialCells(xlLastCell).Column FArk = Sheets("Ark1").Range("a1:" & AD)
Sammenlign = Sheets("Ark2").Range("a1:" & AD)
Application.ScreenUpdating = False For i = 1 To UBound(FArk) For N = 1 To K If FArk(i, N) <> Sammenlign(i, N) Then Sheets("Ark1").Cells(i, N).Interior.Color = vbYellow Sheets("Ark2").Cells(i, N).Interior.Color = vbYellow If FArk(i, N) <> "" And Sammenlign(i, N) = "" Then Sheets("Ark2").Cells(i, N).Interior.Color = vbRed End If End If Next N Next i
Application.ScreenUpdating = True MsgBox K * UBound(FArk) & " celler tog " & Format(Now - ST, "ss") & " sekunder" End Sub
'Ret T1,T2 til dine filnavne samt evt. Ark1 og område A1:R30 til aktuelle 'subben farver matchende værdier blå 'OBS begge filer skal være åbne
Sub sammenlign() Dim c, x Dim tst As String Dim tst2 As String
For Each c In Workbooks("T1").Worksheets("Ark1").Range("A1:R30").Cells c.Activate tst = c.Value If tst = "" Then GoTo ny For Each x In Workbooks("T2").Worksheets("Ark1").Range("A1:R30").Cells tst2 = x.Value If tst = tst2 Then ActiveCell.Font.ColorIndex = 3
denne farver baggrund rød i celler som ikke matcher obs sammenligner første ark (1) i begge filer ret 1 til 2 for næste ark husk begge filer åbnet
Sub sammenlign() Dim c, x Dim tst As String Dim tst2 As String
For Each c In Workbooks("T1").Worksheets(1).Range("A1:R30").Cells If c.Value <> Workbooks("T2").Sheets(1).Range(c.Address) Then Range(c.Address).Interior.ColorIndex = 3 Else Range(c.Address).Interior.ColorIndex = xlNone End If Next
Super - tusind tak. Det virker! Har tilføjet en lille smule, så den kan læse på alle sheets. Lægger du et svar ;)
Sub sammenlign() Dim c, x Dim tst As String Dim tst2 As String
For i = 1 To Sheets.Count
For Each c In Workbooks("T1").Sheets(i).Range("A1:R30").Cells If c.Value <> Workbooks("T2").Sheets(i).Range(c.Address) Then Workbooks("T1").Sheets(i).Range(c.Address).Interior.ColorIndex = 3 Workbooks("T2").Sheets(i).Range(c.Address).Interior.ColorIndex = 3 Else Workbooks("T1").Sheets(i).Range(c.Address).Interior.ColorIndex = xlNone Workbooks("T2").Sheets(i).Range(c.Address).Interior.ColorIndex = xlNone End If Next
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
