Kleine workaround.
Die 9 waarden in je tabblad "data", voeg daar een waarde achter de komma aan toe.
1 wordt dus 1.1, 2 wordt 2.1, etc.
Nu moet je in je formules in de kolommen AG:AI ook dat cijfer gebruiken.
Aangezien je samengevoegde cellen alleen integers zijn, kan je die op die manier uitsluiten en tel je op deze manier alleen je hulpcellen.

grappig, in data is de eerste waarde toch 1,1.
Toch had zo'n aanpassing voor alle getallen de code kunnen vereenvoudigen ...

Sub ZoekenBart()
   Dim LB As Range, c As Range, Tel
   Set LB = Sheets("blad1").Range("D4")                              'cel linksboven je raster, geen samengevoegde cellen in rij 4 en kolom D !!!!

   'methode 1 : kijken naar rasters van 3*3 met 1 resterend getal
   For rij = 1 To 27 Step 3
      For kol = 1 To 27 Step 3
         Set c = LB.Offset(rij, kol)                                 'cel linksboven van zo'n 3*3
         If Not c.MergeCells And WorksheetFunction.Count(c.Resize(3, 3)) = 1 Then
            MsgBox "in raster van cel " & c.Address & " is er nog 1 optie": c.Select: Exit Sub
         End If
      Next
   Next
   
   'methode 2 : tellen resterende opties per rij
   For rij = 1 To 27 Step 3
      Set c = LB.Offset(rij, 1).Resize(3, 27)                        'cel linksboven van zo'n 3*3
      ReDim Tel(9)                                                   'alle tellers op 0
      For i = 1 To 9                                                 'alle waarden aflopen
         Tel(i) = Application.CountIf(c, i)                          'aantal keer een bepaalde waarde
      Next
      For kol = 1 To 27 Step 3
         Set c1 = LB.Offset(rij, kol)
         If c1.MergeCells Then                                       'correctie voor de samengevoegde cellen
            If IsNumeric(c1) Then
               If WorksheetFunction.Median(1, 9, c1.Value) = c1.Value Then Tel(c1.Value) = Tel(c1.Value) - 1
            End If
         End If
      Next
      i = Application.Match(1, Tel, 0)
      If IsNumeric(i) Then
         Set c2 = c.Find(i - 1)
         c2.Select
          Set c3 = LB.Offset(((c2.Row - LB.Row) \ 3) * 3 + 1, ((c2.Column - LB.Column) \ 3) * 3 + 1).Resize(3, 3)
         MsgBox "in de rij " & c.Row & " is er slechts 1 maal de waarde " & i - 1 & " in de cel " & c2.Address & vbLf & "raster " & c3.Address
            Exit Sub
      End If
   Next
   
   'methode 3 : tellen resterende opties per kolom
   For kol = 1 To 27 Step 3
      Set c = LB.Offset(1, kol).Resize(27, 3)                      'cel linksboven van zo'n 3*3
      ReDim Tel(9)                                                   'alle tellers op 0
      For i = 1 To 9                                                 'alle waarden aflopen
         Tel(i) = Application.CountIf(c, i)                          'aantal keer een bepaalde waarde
      Next
      For rij = 1 To 27 Step 3
         Set c1 = LB.Offset(rij, kol)
         If c1.MergeCells Then                                       'correctie voor de samengevoegde cellen
            If IsNumeric(c1) Then
               If WorksheetFunction.Median(1, 9, c1.Value) = c1.Value Then Tel(c1.Value) = Tel(c1.Value) - 1
            End If
         End If
      Next
      i = Application.Match(1, Tel, 0)
      If IsNumeric(i) Then
         Set c2 = c.Find(i - 1)
         c2.Select
         Set c3 = LB.Offset(((c2.Row - LB.Row) \ 3) * 3 + 1, ((c2.Column - LB.Column) \ 3) * 3 + 1).Resize(3, 3)
         MsgBox "in de kolom " & c.Column & " is er slechts 1 maal de waarde " & i - 1 & " in de cel " & c2.Address & vbLf & "raster " & c3.Address
         Exit Sub
      End If
   Next

End Sub

Hallo Bart,

ik heb je code even getest "in de vlugte..." en hij geeft mij enkel een melding bij cel U18 (waarde 5) bij horizontaal zoeken.
Ik heb even handmatig gezorgd dat er in het linksboven raster van 3 x 3 maar één 5 staat.
maar als je macro gaat kijken naar "rasters van 3*3 met 1 resterend getal", dan geeft hij geen melding.

Ook staat er voor het zoeken in verticale Ranges ( in F29) een enkele waarde 2, en ook daar geeft de macro geen melding van.

Het lezen gaat wel redelijk, omdat ik weet wat ik mag verwachten, maar ik zal nooit de skills hebben die jij hebt,
laat dat duidelijk zijn 

SoftAid              

Dag Bart,

Dank je om mij op mijn tempo te laten leren 

? Is er iets mis met deze lijn in je code:
 MsgBox "in raster van cel " & c.Address & " is er nog 1 optie": c.Select: Exit SubMag dit mogelijk zo zijn:
MsgBox "in raster van cel " & c.Address & " is er nog 1 optie:" & c.Select
Je hebt ook geen code om via Msgbox weer te geven als er 2 verschillende maar unieke waarden staan (in dezelfde Range).
Normaal verwacht je dan dat de macro je één Msgbox geeft, na een OK terug gaat kijken of er nog een tweede (of derde) moet gemeld worden? Dat zit er dus niet in  .

Maar, we geraken er wel aan uit 
Groeten,

SoftAid              

MsgBox "in raster van cel " & c.Address & " is er nog 1 optie": c.Select: Exit Sub

je voorstel om dit aan te passen werkt niet, in mijn regel waren dat 3 verschillende acties, gescheiden door die ":".
Voor de leesbaarheid had ik daar dus beter 3 regels van gemaakt.
Jouw voorstel zal dus met een foutboodschap eindigen, want die messagebox moet iets fouts weergeven.

Andere opmerking, als er meerdere unieke getallen voorkomen binnen een "grote" rij (= 3 kleine rijen), dan werd er maar 1 afgewerkt.
Klopt inderdaad. Voor methode 2 heb ik daar een do-loopje bijgezet en die werkt ze dan alle af.
Mits je wilde leren, kan je dit anders ook overzetten naar methode 3

Hallo SoftAid,

Je versie 5 stond al bij me klaar toen ik voor een tijdje werd weggeroepen, en heb daarna zonder aan te melden de volgende posts diagonaal gelezen waardoor ik niet had gezien dat je al versie 6 had meegegeven...
Het meeste uit mijn #38 is dus achterhaald, maar een ander deel is wel degelijk bruikbaar. Ik heb het op de juiste plaats in mijn huidige bijlage aan de code toegevoegd.

Even een kleinigheid tussendoor : je interne bladnaam Blad1 heette voor jou Blad2, en vice versa. Die heb ik toch maar aangepast om latere verwarring uit te sluiten...
Alle code in de modules heb ik ongewijzigd gelaten (maar je weet maar nooit of je in een latere fase misschien toch nog eens de efficiëntere werkwijze die ik je in een veel eerder stadium had aangeboden nog eens bovenhaalt).

Dus: enkel met de code die aan Blad1 gekoppeld is heb ik een beetje gespeeld. Je vindt er ook wat 'algemene leerstof' in terug. Ik zag daar namelijk ergens een Gosub staan, maar dat werkt niet op die manier. Een blik op de code zal meteen duidelijk maken hoe het wel kan.

In de code "oplossing" zitten een paar kleine dingetjes om te vermijden dat een ongelukkige klik roet in het eten gooit. Vooreerst wordt gekeken of je wel binnen je kader staat, én in een niet-samengestelde cel, én in niet meer dan één. Daarna wordt de samen te stellen range bepaald, om het even welke cel geselecteerd is binnen die 9 cellen (dat is het stukje dat ik uit mijn voorgaande code heb geplukt).
Een lichte verbetering?

Groeten,
pitufo

Hallo cow18,

Voor methode 2 heb ik daar een do-loopje bijgezet en die werkt ze dan alle af.
Mits je wilde leren, kan je dit anders ook overzetten naar methode 3

Inderdaad. Ik wil graag bijleren. Maar soms gaat het niet zoals verwacht.

Ik wilde de Do-While-loop eerst in de eerste routine zetten, deze die al de 3*3 aanpakt op maar 1 getal.
Als je deze routine maar éénmaal laat lopen, dan vind hij ook maar een beperkt aantal "singles".
Daarom moet hij gevonden singles eerst omzetten naar Merged cells en dan opnieuw de hulpcellen aanpassen.
Na die Maak_hulpcellen() vindt de routine nieuwe singles, en zal deze ook aanpassen.
Als er geen singles meer gevonden worden moet de routine uit de Do-While-loop gaan, en beginnen aan de 2 de methode: zoeken per Rij.
Wat is mijn probleem: ik kan uit je code geen argument kan aanhalen die de Do-While-loop stopt zonder vast te lopen, zonder macro-onderbreking.
Ik had nu maar het meest voor de hand liggende genomen:

Loop While Not c.MergeCells And WorksheetFunction.Count(c3) > 1
Ik voeg een voorbeeldbestand bij. Mocht je zin en tijd hebben.... 

SoftAid