Find dubleret kolonne ud af 150

Skal de stå på samme række?

Altså indhold A6:A8 står i ES12:ES14 - skal den også tælle?

Hvormange kolonner har du?

1. identisk indhold i samme række?
  eks A6=F6 og A10=F10 eller er de også identiske hvis A6=F10 og A10=F6

2. Hvad vil du have gjort ved identiske kolonner?
    Farvelagt baggrunden i kolonnen, eller?



Mvh Jan

Hej Jan

1. Ja, identisk indhold i samme række A6=F6 og A10=F10

2. Farve ville være helt fint

Måske kan denne makro bruges. jeg har gået ud fra at flere sæt kolonner kan være ens. De bliver så farvet med forskellige farver.

Dim Col1, Col2, Row1, Row2, x, y, Color As Integer
Color = 3
For Col1 = 1 To 149
For Col2 = Col1 + 1 To 150
Row1 = Cells(65356, Col1).End(xlUp).Row
Row2 = Cells(65356, Col2).End(xlUp).Row
If Row1 = Row2 Then
y = 0
For x = 6 To Row1
If Cells(x, Col1) <> Cells(x, Col2) Then
y = 1
End If
Next
If y = 0 And Row1 > 6 Then
Range(Cells(6, Col1), Cells(Row1, Col1)).Interior.ColorIndex = Color
Range(Cells(6, Col2), Cells(Row1, Col2)).Interior.ColorIndex = Color
Color = Color + 1
End If
End If
Next
Next
End Sub

#4 et par små tilføjelser til din kode som gør makroen renser formateringen før den laver den for gentagne kørseler ikke giver forkert resultat (hvis der er blevet ændret i data mellem to kørsler)

Option Explicit

Dim Col1 As Integer, Col2 As Integer, Row1 As Integer, Row2 As Integer
Dim x As Integer, y As Integer, Color As Integer
Sub Test()
' øger hastighed på macroen
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
' renser baggrunden på alle celler
Color = 0
For Col1 = 1 To 140
    Row1 = Cells(65356, Col1).End(xlUp).Row
    Range(Cells(6, Col1), Cells(Row1, Col1)).Interior.ColorIndex = Color
Next
' ligger baggrund på identiske kolonner
Color = 3
For Col1 = 1 To 149
    For Col2 = Col1 + 1 To 150
        Row1 = Cells(65356, Col1).End(xlUp).Row
        Row2 = Cells(65356, Col2).End(xlUp).Row
        If Row1 = Row2 Then
            y = 0
            For x = 6 To Row1
                If Cells(x, Col1) <> Cells(x, Col2) Then
                    y = 1
                End If
            Next
            If y = 0 And Row1 > 6 Then
                Range(Cells(6, Col1), Cells(Row1, Col1)).Interior.ColorIndex = Color
                Range(Cells(6, Col2), Cells(Row1, Col2)).Interior.ColorIndex = Color
                Color = Color + 1
            End If
        End If
    Next
Next
' slår skærmopdateringen og beregning til igen
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

mvh Jan

Jeg havde ikke fået kopieret første linie af makroen med over, men med Jans forbedringer og i øvrigt gode forklaringer skulle det være sat på plads