27. januar 2007 - 11:18
Der 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
27. januar 2007 - 16:52
#1
'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
Next
ny:
Next
End Sub
27. januar 2007 - 18:17
#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
End Sub
28. januar 2007 - 14:15
#4
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
Next
End Sub
