Recherche "d'îlots de chiffres"

Bonjour à tous,

Je me tourne vers vous car j'ai un problème assez simple à comprendre mais à mon avis très complexe à résoudre...

J'ai dans un onglet des îlots de chiffres non nuls, de taille et de géométrie variables, délimité par des 0.

J'aimerai pouvoir extraire, à l'aide d'une macro, ces îlots dans différents onglet afin de mener des analyses statistiques sur chaque ilôt séparément.

Mes deux questions sont :

1. Est-ce que c'est réalisable?

2. Si oui, par où démarrer?

Merci beaucoup pour votre aide!

bonjour

tu ne nous dis pas comment tu veux les reclasser (en liste, en plages...) et pour quelle exploitation ???

En fait dans un premier temps je veux pas les classer, je veux juste extraire tous les points dans un onglet distinct par "îlot".

Ça peut être sous la même forme qu'il sont à la base ou bien sur une colonne ou sur une ligne.

sur feuille 2, en A1

=SI (A1defeuille1=0;"";A1defeuille1)

formule à étendre vers le bas et la droite

s tu veux récupérer une feuille sans formules mais avec juste les valeurs non nulles, alors tu copies la feuille 2 ainsi obtenue et tu colles "collage spécial valeur"

Merci jmd pour ta réponse.

En fait c'est pas tout à fait ce que voudrais : j'aimerais pouvoir faire un onglet par îlot de chiffres et non pas récupérer tous les chiffres non nuls dans un même onglet.

En gros sur l'image de mon premier post, je voudrais un onglet par cercle rouge que j'ai dessiné.

bonjour

bon alors ( a l'aveuglette)

1) tu nommes (definir un nom ) l'ilot

2) = petite.valeur(si (ilot>0;ilot;"");ligne(a1) tu valides en faisant Ctrl Maj Enrée les 3touches en memetemps et tu tires vers le bas

les données seront extraites et classeés en croissant ;pour decroissant utilise Grande .valeur

cordialement

Le soucis c'est que justement j'aimerais ne pas devoir sélectionner manuellement les îlots (pour les nommer ou les copier/coller) mais écrire une macro qui les détecte et les recopie dans des onglets séparés...

re

bah...... ; il suffirait de savoir pourquoi la fin d'un ilot engendre le debut d'un autre ; par exemple

cordialement

Et bien la fin géométrique des îlots est juste délimité par des 0... après en ce qui concerne la répartition de ces îlots et leur forme est aléatoire...

re

autrement dit ;il faut que l'integalité d'une plage dont la largeur (a determiner avec sommepod par exemple ) soit garnie de 0

on pourrait avoir çà avec une analyse de la somme de chaque ligne ;si la somme = 0 >>>bingo on change d'ilot a compter de cette ligne

qu'en pensez vous ?

bonjour à vous

est-ce comme une carte du monde, avec :

• des océans de zéros,
• des continents <>0, des îles <>0 dans les océans,
• des lacs de zéros dans les continents,
• des îles <>0 dans les lacs,
• des étangs qui sont dans les îles qui sont dans des lacs qui sont dans des continents qui sont dans des océans ?

en gros, quelles imbrications vas-tu rencontrer ?

tu veux une feuille par "territoire" ? combien peut-il y en avoir au final, des milliers ?

Merci à vous deux pour vos contributions.

Alors jmd en fait il n'y a que deux "typologies" :

1. Les îles de chiffres <>0

2. "L'océan" qui entoure ces îles, constitué de 0.

J'aimerais pouvoir extraire chaque ile dans un onglet différent.

Tulipe_4 je ne comprends pas bien ce que tu proposes.

re

bon alors je m' explique

les valeurs en rouge servent de balise

cordialement

Cette technique ne marche pas pour toutes les configurations d'îlots : par exemple ceux que j'ai mis en exemple dans mon 1er post.

Bonjour,

Une proposition de solution via une macro. lancer la macro test via alt-f8

Waouh on y est presque merci beaucoup h2so4!

Ça marche très bien sur l'exemple que tu as fait!

Je vais essayer de regarder ça cette après-midi.

Encore merci h2so4!

Bonjour,

voici une version adaptée pour distinguer ce type d'îlot

Dim pl(100, 100)
Sub test()
    Erase pl
    Dim ctrl(100)
    Set ws1 = Worksheets("sheet1")
    For i = 1 To 100
        For j = 1 To 100
            If ws1.Cells(i, j) <> 0 Then
                If i > maxi Then maxi = i
                If j > maxj Then maxj = j
                If pl(i, j) = 0 Then
                    npl = npl + 1
                    pl(i, j) = npl
                    ws1.Cells(i, j).Interior.ColorIndex = npl + 2
                    delimitilot ws1, i, j, npl
                End If
            End If
        Next j
    Next i
    For k = 1 To npl
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = "ilot" & k
    Next k
    For i = 1 To maxi
        For j = 1 To maxj
            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

Sub delimitilot(ws1, i, j, npl)
    For ik = -1 To 1
        For jk = -1 To 1
            If ik = 0 Or jk = 0 Then
                ii = i + ik: jj = j + jk
                If ii > 0 And jj > 0 And ii < 101 And jj < 101 Then
                    If ws1.Cells(ii, jj) <> 0 And pl(ii, jj) = 0 Then
                        pl(ii, jj) = npl
                        ws1.Cells(ii, jj).Interior.ColorIndex = npl + 2
                        delimitilot ws1, ii, jj, npl
                    End If
                End If
            End If
        Next jk
    Next ik
End Sub

Bon bah c'est impeccable ça marche!

Merci beaucoup H2SO4 !

Salut salut!

En fait j'ai encore un tout petit problème :/

J'ai testé sur un fichier un peu plus gros, et il me sort le problème de l'espace pile insuffisant.

Je crois qu'il doit y avoir trop de boucles imbriquées dans la fonction "delimitilot".

Je précise que j'ai bien changé les dimensions :

Dim pl(250, 250)

Sub test()
     Set ws1 = Worksheets("ImportResultat") 
    Erase pl
    Dim ctrl(100)

    For i = 1 To 250
        For j = 1 To 250
            If ws1.Cells(i, j) <> 0 Then
                If i > maxi Then maxi = i
                If j > maxj Then maxj = j
                If pl(i, j) = 0 Then
                    npl = npl + 1
                    pl(i, j) = npl
                    ws1.Cells(i, j).Interior.ColorIndex = npl + 2
                    delimitilot ws1, i, j, npl
                End If
            End If
        Next j
    Next i
    For k = 1 To npl
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = "ilot" & k
    Next k
    For i = 1 To maxi
        For j = 1 To maxj
            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

Sub delimitilot(ws1, i, j, npl)
    For ik = -1 To 1
        For jk = -1 To 1
            If ik = 0 Or jk = 0 Then
                ii = i + ik: jj = j + jk
                If ii > 0 And jj > 0 And ii < (251) And jj < (251) Then
                    If ws1.Cells(ii, jj) <> 0 And pl(ii, jj) = 0 Then
                        pl(ii, jj) = npl
                        ws1.Cells(ii, jj).Interior.ColorIndex = npl + 2
                        delimitilot ws1, ii, jj, npl
                    End If
                End If
            End If
        Next jk
    Next ik
End Sub

bonsoir,

une version de la macro qui s'adapte aux dimensions de ton tableau. et qui fonctionne sur le fichier que tu as fourni.

il se peut effectivement que l'on atteigne des limites au niveau de la pile qui se forme lors des appels imbriqués de delimitilot.

si tu continues à avoir des problèmes, il faudra que je revoie l'algorithme pour simuler les appels imbriqués.