Deplacement cellules

[ABDELHAK]

Bonjour à tous,

Je suis novice en vba et je cherche de l’aide pour résoudre mon problème, merci d’avance.
Voici mon problème :
J’ai 1 tableau qui comporte 30 lignes et 50 colonnes (CELLULE B5 à CELLULE AY34) soit 1500 cellules au total
Il y a seulement des chiffres de 1 à 100 (soit 100 valeurs) éparpillés dans le tableau de manière aléatoire..
Parmi ces valeurs, il y en a 20 dont les cellules ont un fond vert.
Le but est de réaliser une macro qui permet de reconnaître :
- dans un premier temps les 20 cellules à fond vert
- dans un second temps de déplacer ces cellules avec leurs contenus (chiffres de 1 à 100) dans les cellules vides de la colonne voisine
Exemple :
Si B5 a un fond vert alors déplacer B5 vers C5 si elle est vide.
Si B6 a un fond vert alors déplacer B6 vers C5 si elle est vide.
Et ainsi de suite pour les 1500 cellules que comportent mon tableau
Pouvez-vous m’aider s’il vous plait ?

 

[VDAVID]

Re : Deplacement cellules

Bonjour Abdelhak,

Peut-être que tu aurais plus de chances de réponses en mettant un petit fichier exemple simplifié (sans données confidentielles) avec situation de départ et résultat attendu.

Ce que tu décris semble faisable, mais que faire, par exemple, si B5 possède un fond vert mais que C5 n'est pas vide ...?

Bonne journée

 

[ABDELHAK]

Re : Deplacement cellules

Bonjour à tous,

En réponse à la question :
Exemple :
Si B5 a un fond vert et que C5 est remplie, il faut absolument que la macro trouve une cellule vide mais dans la colonne C.
Si C5 a un fond vert et que D5 est remplie, il faut absolument que la macro trouve une cellule vide mais dans la colonne D.
Si D5 a un fond vert et que E5 est remplie, il faut absolument que la macro trouve une cellule vide mais dans la colonne E
Et ainsi de suite
J’espère que vous m’avez compris.

 

[job75]

Re : Deplacement cellules

Bonjour ABDELHAK, VDAVID,

Voyez cette macro dans le fichier joint :

Sub Déplacement()
Dim plage As Range, col%, tablo() As Boolean, i&, j%, c As Range
Set plage = [B5:AY34]
col = plage.Columns.Count
ReDim tablo(1 To plage.Rows.Count, 1 To col)
For i = 1 To UBound(tablo)
  For j = 1 To col
    If plage(i, j).Interior.ColorIndex = 4 Then tablo(i, j) = True
  Next
Next
Application.ScreenUpdating = False 'accélère la macro
For i = 1 To UBound(tablo)
  For j = 1 To col
    If tablo(i, j) Then
      If plage(i, j + 1) = "" Then
        plage(i, j).Cut plage(i, j + 1) 'couper-coller
      Else
        Set c = plage.Columns(j + 1).Find("", , xlValues, xlWhole)
        If Not c Is Nothing Then plage(i, j).Cut c
      End If
    End If
  Next
Next
End Sub

Clic sur le bouton en haut à gauche.

A+

 

[job75]

Re : Deplacement cellules

Re,

Le fichier (1) étudiait le tableau par lignes puis par colonnes.

Ce fichier (1 bis) l'étudie par colonnes puis par lignes.

Bien entendu on obtient des résultats différents.

A+

 

[ABDELHAK]

Quelques mots d'excuses pour job75

Bonjour à tous,

Quelques mots pour job75, je ne vous remercierai jamais assez pour l’aide que vous m’avez accordé. Et pour cela je vous serai éternellement reconnaissant.
Je veux par ces quelques lignes vous présenter mes excuses.
En effet, c’est la 1ière fois que je participe à un forum comme celui-ci. Si j’ai « abusé », c’est plus par ignorance qu’autre chose.
Ceci étant dit, si il m’arrive encore de « déraper », je ne vois personnellement aucuns inconvénients à ce qu’on me remette sur les « rails ».

A +

PS : 1000*10000*100000……….MERCI’SSSSSSSSSSSSSSSSSSS