Recherche "d'îlots de chiffres"

Merci pour ta réponse rapide h2So4!

Malheureusement j'ai toujours le problème d'espace pile qui revient, au niveau du premier îlot.

La macro avance un peu plus loin mais ça bloque un petit peu avant la fin du premier îlot.

Tu n'as pas le problème sur ton pc toi? Peut-être y a t-il un réglage à faire?

Bonsoir,

pas de problème chez moi. je suis sous windows 8 64 bits avec excel 2010.

je te mets le résultat, Je regarderai dès que j'en aurai l'occasion pour une autre solution. (sans doute mercredi)

Moi aussi windows 8.1 en 64 bits avec excel 2010... c'est étrange que ça puisse varier autant d'un ordi à l'autre!

N'as-tu pas des formules, des macros evenementielles ou des mfc ?

Euh c'est à dire?

Non je n'ai fait qu'ouvrir ton fichier et essayer de le faire tourner...

Bonsoir,

je reste intrigué par le fait que cela fonctionne sans problème chez moi et que cela ne fonctionne pas chez toi.

une solution sans appel récursif.

Sub test()
    Set ws1 = Worksheets("feuil1")
    Dim pl%(), pile%(10000, 2), ctrl%()
    maxl% = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    maxc% = ws1.Cells(6, Columns.Count).End(xlToLeft).Column
    npl% = 0
    ReDim pl(maxl, maxc)
    For i% = 6 To maxl
        For j% = 1 To maxc
            If ws1.Cells(i, j) <> 0 And pl(i, j) = 0 Then
                npl = npl + 1
                pl(i, j) = npl
                p% = 1
                pile(p, 1) = i
                pile(p, 2) = j
                While p > 0
                    p1% = p
                    ws1.Cells(pile(p1, 1), pile(p1, 2)).Interior.ColorIndex = npl + 2
                    For ik% = -1 To 1
                        For jk% = -1 To 1
                            If ik = 0 Or jk = 0 Then
                                ii% = pile(p1, 1) + ik: jj% = pile(p1, 2) + jk
                                If ii > 5 And ii <= maxl And jj > 0 And jj <= maxc Then
                                    If ws1.Cells(ii, jj) <> 0 And pl(ii, jj) = 0 Then
                                        pl(ii, jj) = npl
                                        p = p + 1
                                        If p > maxp Then maxp = p
                                        pile(p, 1) = ii
                                        pile(p, 2) = jj
                                    End If
                                End If
                            End If
                        Next jk
                    Next ik
                    If p1 = p Then p = p - 1
                Wend
            End If
        Next j
    Next i
    MsgBox "taille max de la pile " & maxp & vbNewLine & "nombre d'ilots " & npl
    ReDim ctrl(npl)
    For k% = 1 To npl
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = "ilot" & k
    Next k
    For i = 6 To maxl
        For j = 1 To maxc
            If pl(i, j) <> 0 Then
                ctrl(pl(i, j)) = ctrl(pl(i, j)) + 1
                Sheets("ilot" & pl(i, j)).Cells(ctrl(pl(i, j)), 1) = ws1.Cells(i, j)
            End If
        Next j
    Next i
End Sub

Là ça marche super!

T'es un boss h2so4

Mais c'est vrai que cette histoire de pile est étrange, j'ai eu le problème sur un ordi et pas sur un autre...