Zoeken op dubbele waarden binnen een bepaald bereik

[Robert Smidt]

Beste Forumleden,

Graag zou ik hulp willen hebben bij een VBA-code in Excel.

Ik heb een werkblad (vragenformulier) waar in kolom H41 t/m kolom H218 zowel tekst als numerieke getallen staan. Nu is het de bedoeling dat in voornoemde kolom geen dubbele numerieke getallen in voor mogen komen. Daarom ben ik op zoek naar een code die uitsluitend kijkt naar de numerieke getallen en wanneer een dubbel getal wordt gesignaleerd dat het systeem deze blauw van kleur maakt. Bovendien moet het systeem, nadat deze alles heeft gecontroleerd, ook een melding geven dat er één of meerdere dubbele getallen aanwezig zijn.

Alvast heel hartelijk dank.

Robert

 

[edmoor]

En je voorbeeld bestand?

 

[Robert Smidt]

Het is super groot bestand met veel persoonlijke informatie. Ik zal een voorbeeldbestand maken.

 

[edmoor]

Daarom zei ik ook, voorbeeld bestand.

 

[AccessGuru]

Waarom VBA? Met een hulpkolommetje is het zonder programmeren heel simpel:

=ALS(AANTAL.ALS(H$4:H4;H4)>1;"x";"")

En dan VO op kolom H om ze te markeren.

 

[Robert Smidt]

Ik hoop dat je hier iets mee kunt.

 

[Robert Smidt]

Mijn voorkeur gaat uit naar een vba-code aangezien ik al een controletool heb ontwikkeld waar dit een onderdeel van wordt. Maar heel fijn dat je meedenkt met de oplossing.

 

[JEC.]

Probeer het hier eens mee

Sub jec()
  Dim it, ar, a As Variant
  
  Set ar = Range("H41", Range("H" & Rows.Count).End(xlUp))
  Set a = Cells(1, 999)
  ar.Interior.ColorIndex = 0
  
  With CreateObject("scripting.dictionary")
    For Each it In ar
      If IsNumeric(it.Value) Then
         If .exists(it.Value) Then Set a = Union(a, it)
         .Item(it.Value) = ""
      End If
    Next
    If a.Count > 1 Then
      a.Interior.ColorIndex = 8
      MsgBox "dubbele waarde gevonden"
    End If
  End With
End Sub

 

[Robert Smidt]

Bedankt voor jouw bericht.

In het testprogramma werkte het perfect, alleen nu ik het in het officiële programma gebruik, stuit ik op een tweetal foutjes. Ten eerste pakt het systeem nu ook de lege cellen (deze ziet dit ook als dubbel) en het bereik tot aan regel 218 is hier nog niet in opgenomen. Verder ben ik hier al heel gelukkig mee.

 

[JEC.]

Zijn de lege cellen geen nullen?

 

[Robert Smidt]

Ik zie net dat het systeem niet reageert op lege cellen maar cel opvulling. Op de één of andere manier ziet deze dat ook voor een numeriek aan.

 

[Robert Smidt]

Hierbij een voorbeeld bestand waar het fout gaat.

 

[JEC.]

Morgen kan ik kijken, of iemand anders kan het aanvullen zo

 

[HSV]

Kleine aanpassing maar.

If IsNumeric(it.Value) [COLOR=#ff0000]And it <> "" [/COLOR]Then

@Jveer,

Zag het al vaker bij je.
Met onderstaande declareer je ze niet alle drie als variant alhoewel ze het wel zijn zo.

 Dim it, ar, a As Variant

ar is eigenlijk een Range type.

Bv. niet denkende dat alle drie in onderstaande als Long gedeclareerd zijn.

 Dim it, ar, a As long

Alleen a is een Long, de andere twee zijn type Variant.

 

[Robert Smidt]

Ik heb het probleem weten te omzeilen.

  Dim it, ar, a As Variant
  Set ar = Range("H41", Range("H" & Rows.Count).End(xlUp))
  Set a = Cells(1, 999)
    Rem   ar.Font.ColorIndex = 0
    With CreateObject("scripting.dictionary")
    For Each it In ar
        [B]If it.Offset(, -5).Value = "KvK-nr." Then[/B]
          If IsNumeric(it.Value) Then
             If .exists(it.Value) Then Set a = Union(a, it)
             .Item(it.Value) = ""
          End If
        End If
    Next
    If a.Count > 1 Then
      a.Font.ColorIndex = 3
      MsgBox "Het systeem heeft dubbele KvK-nr(s) gevonden, deze staan in het rood!"
    End If
  End With

Nu rest mij alleen nog het bereik waar de code betrekking op heeft.

In ieder geval ben ik nu al enorm geholpen, heel hartelijk dank hiervoor.

 

[JEC.]

@hsv, ik weet er inderdaad van. Alleen als ze allemaal een variant zijn, gebruik ik de notatie zoals ik het hier doe. Anders declareer ik ze apart.