Dubbele Waarden VBA

[Gerard2348]

Beste Forumleden,

Ik heb op internet een VBA code gevonden (en iets aangepast) om dubbele waardes te vinden. Deze code voldoet maar neemt nogal wat tijd in beslag. Hij checkt op exacte waardes.

Nu vraag je je af waarom niet met voorwaardelijke opmaak? Dit omdat ik de dubbele namen met zgn. aan/uit wil checken dus niet constant. En het blad kleurt al cellen bij een bepaalde waarde d.m.v. voorwaardelijke opmaak.

Mijn vraag is;
Is deze code te versnellen en is het mogelijk om te checken zonder onderscheid te maken tussen hoofd en kleine letters.

Mvg Geer

Bekijk bijlage Dubbele namen.xlsm

 

[Cobbe]

Deze zou toch aanzienlijk sneller moeten zijn:

Sub DubbeleWaarden()

  Dim rge As Excel.Range
  Dim rgeFind As Excel.Range
  Dim varValue As Variant
    Application.ScreenUpdating = False
  For Each rge In Range("C6:C50,H6:H50,M6:M50,R6:R50").SpecialCells(xlCellTypeConstants)
  
      varValue = rge.Value
      For Each rgeFind In Range("C6:C50,H6:H50,M6:M50,R6:R50").SpecialCells(xlCellTypeConstants)
        If rgeFind.Address <> rge.Address Then
          If rgeFind.Value = varValue Then
      rgeFind.Font.ColorIndex = 3
     
     End If
    End If
   Next
  Next
Application.ScreenUpdating = True
 End Sub

 

[Gerard2348]

Wow,

Wow aanzienlijker sneller. Dag en Nacht verschil.
Ben er blij mee. :thumb:

Vwb mijn tweede deel van mijn vraag;
is het mogelijk om te checken zonder onderscheid te maken tussen hoofd en kleine letters.

wordt dat een lastig probleem?

met vriendelijke groet,

Geer

 

[Cobbe]

Dan zou deze moeten werken:

Sub DubbeleWaarden()
  Dim rge As Excel.Range
  Dim rgeFind As Excel.Range
  Dim varValue As Variant
    Application.ScreenUpdating = False
  For Each rge In Range("C6:C50,H6:H50,M6:M50,R6:R50").SpecialCells(xlCellTypeConstants)
  [COLOR="#FF0000"]varValue = UCase(rge.Value)[/COLOR]     
 For Each rgeFind In Range("C6:C50,H6:H50,M6:M50,R6:R50").SpecialCells(xlCellTypeConstants)
        If rgeFind.Value <> rge.Value Then
[COLOR="#FF0000"]If UCase(rgeFind.Value) = varValue Then[/COLOR]      
rgeFind.Font.ColorIndex = 3
     
     End If
    End If
   Next
  Next
Application.ScreenUpdating = True
 End Sub

 

[snb]

of

Sub M_snb()
    Cells.FormatConditions.Delete
    sn = [if(countif(C5:R36,C5:R36)>1,if(mod(column(C5:R36),5)=3,address(row(C5:R36),column(C5:R36)),""),"")]
    
    For Each it In sn
      If it <> "" Then Range(it).Interior.ColorIndex = 3
    Next
End Sub

 

[Gerard2348]

Goedemorgen Cobbe & Snb,

Een reactie van mijn kant. Ben altijd blij met de aangedragen oplossingen.

Cobbe de tweede oplossing die je hebt gegeven om te controleren zonder onderscheid te maken tussen hoofd en/of kleine letters werkt ten delen. Hij pakt namelijk niet alles.

snb jouw code werkt maar verwijderd gelijk alle voorwaardelijke opmaak wat niet wenselijk is.

Mvg Geer

 

[Cobbe]

Ik had toch de foute code gepost:

Sub DubbeleWaarden()
  Dim rge As Excel.Range
  Dim rgeFind As Excel.Range
  Dim varValue As Variant
  Application.ScreenUpdating = False
  For Each rge In Range("C6:C50,H6:H50,M6:M50,R6:R50").SpecialCells(xlCellTypeConstants)
    varValue = UCase(rge.Value)
     For Each rgeFind In Range("C6:C50,H6:H50,M6:M50,R6:R50").SpecialCells(xlCellTypeConstants)
      If rgeFind.Address <> rge.Address Then
       If UCase(rgeFind.Value) = varValue Then
        rgeFind.Font.ColorIndex = 3
       End If
      End If
    Next
  Next
  Application.ScreenUpdating = True
End Sub

 

[snb]

Dan zet je toch gewoon een commentaarteken voor die eerste regel ?

 

[Gerard2348]

Cobbe,

Helemaal top:thumb:

snb dat had ik al geprobeerd maar dan gebeurd er niets.

Mvg Geer

 

[Gerard2348]

Sorry snb

Heb het even in een nieuw bestandje geprobeerd en voila...

Met een kleine aanpassing;

Sub M_snb()
   ' Cells.FormatConditions.Delete
    sn = [if(countif(C5:R36,C5:R36)>1,if(mod(column(C5:R36),5)=3,address(row(C5:R36),column(C5:R36)),""),"")]
    
    For Each it In sn
     [COLOR="#FF0000"] If it <> "" Then Range(it).Font.ColorIndex = 3[/COLOR]    Next
End Sub

werkt het perfect.

 

[snb]

Zucht,,,

Er gebeurt niets in het Nederlands.

Er gebeurt wel iets maar het is niet zichtbaar door de voorwaardelijke opmaak.
Bestudeer je de code eigenlijk wel ?
Dan had je hem toch zelf eenvoudig kunnen aanpassen ?

Sub M_snb()
'    Cells.FormatConditions.Delete
    sn = [if(countif(C5:R36,C5:R36)>1,if(mod(column(C5:R36),5)=3,address(row(C5:R36),column(C5:R36)),""),"")]
    
    For Each it In sn
      If it <> "" Then Range(it).Font.ColorIndex = 3
    Next
End Sub

 

[Gerard2348]

snb,

Zie mijn eerdere bericht. Die van 10:15 uur. Uiteraard bestudeer ik de aangedragen codes. Ik heb respect voor eenieder die een oplossing geeft.

Mvg geer

 

[snb]

Gelukkig. :thumb: