Macro pour transfert et ajout de nombres nouveaux.

jeanjacques

XLDnaute Junior
Bonjour,

Pourriez-vous m'aider pour ce fichier de transfert de nombres de la base à l'écriture de ces nombres en fonction de la plage ?

Je joins un exemple avec 5 lignes de données dans la plage. Chaque fois que des nombres nouveaux apparaissent, ils sont sortis de la base (une couleur différente par ligne et même couleur dans la base) et copiés à la suite dans le tableau à partir de la colonne F.

Merci de votre aide.

JeanJacques
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Re : Macro pour transfert et ajout de nombres nouveaux.

hello

pas sur d'avoir bien compris le besoin.. mais essaie ce code
Code:
Sub recopie()

For i = 15 To 11 Step -1
    Set liste = Range("A" & i & ":E" & i)
    If i = 15 Then
        fin = 6
    Else: fin = Cells(i + 1, Range(i & ":" & i).Columns.Count).End(xlToLeft).Column + 1
    End If
    For Each nb In liste
        Set nouveau = Range(Cells(i, 6), Cells(i, fin)).Find(nb)
        If nouveau Is Nothing Then
            Cells(i, fin) = nb
            Cells(i, fin).Font.ColorIndex = i
            fin = fin + 1
        End If
    Next nb
Next i
End Sub
PS: pour que ca fontionne pour la ligne 12, il faut effacer le texte "base 70" sous ton tableau tout à droite
 

jeanjacques

XLDnaute Junior
Re : Macro pour transfert et ajout de nombres nouveaux.

Bonjour

Merci pour ta macro mais elle rajoute tout à la suite, il faut à chaque ligne, sortir les nouveaux nombres de la base et rajouter (uniquement les nouveaux nombres et en couleur différente)
merci
 

vgendron

XLDnaute Barbatruc
Re : Macro pour transfert et ajout de nombres nouveaux.

c'est pas clair du tout comme demande..
peux tu reposter ton fichier avec le point de départ..
et donner les étapes détaillées à suivre : quel chiffre tu copies ou en fonction de quoi..
la base. je viens tout juste de comprendre que tu parles du tableau complètement à droite..non visible à l'écran..
 

vgendron

XLDnaute Barbatruc
Re : Macro pour transfert et ajout de nombres nouveaux.

Bon.. je pense avoir décrypté....

Code:
Sub recopie2()

For i = 15 To 11 Step -1
    Set liste = Range("A" & i & ":E" & i)
    If i = 15 Then
        fin = 6
    Else: fin = Cells(i + 1, Range(i & ":" & i).Columns.Count).End(xlToLeft).Column + 1
    End If
    
    For Each nb In liste
        If i = 15 Then
            Set nouveau = Range(Cells(i, 6), Cells(i, fin)).Find(nb, lookat:=xlWhole)
        Else
            Set nouveau = Range(Cells(i + 1, 6), Cells(15, fin)).Find(nb, lookat:=xlWhole)
        End If
        If nouveau Is Nothing Then
            Cells(i, fin) = nb
            Cells(i, fin).Font.ColorIndex = i
            With Range("Base70")
                Set ici = .Find(nb, lookat:=xlWhole)
                If Not ici Is Nothing Then
                    ici.Interior.ColorIndex = i
                    ici.ClearContents
                End If
            End With
            fin = fin + 1
        Else
            Cells(i, nouveau.Column) = nb
        End If
    Next nb
Next i
End Sub
il faut donner un nom de zone à ton tableau à droite : "Base70"
 

jeanjacques

XLDnaute Junior
Re : Macro pour transfert et ajout de nombres nouveaux.

Re,

En ajoutant une ligne de données, 3 nombres (en rouge) ne s'alignent pas et sont comptés comme nouveaux alors qu'ils sont déjà présents. Est-ce grave docteur?

merci
ps: peut-on mettre une couleur fixe aux ajouts et à la base (rouge par ex) merci
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Re : Macro pour transfert et ajout de nombres nouveaux.

voir proposition

Code:
Sub recopie2()
'récupère la dernière ligne du tableau
dernièreligne = Range("A" & Rows.Count).End(xlUp).Row
'on set la première ligne en début de macro, plus besoin de modifier les indices dans la macro
premièreligne = 11
Range("F" & premiereligne & ":Z" & derniereligne).ClearContents
For i = dernièreligne To premièreligne Step -1
    Set liste = Range("A" & i & ":E" & i)
    If i = dernièreligne Then
        fin = 6
    Else: fin = Cells(i + 1, Range(i & ":" & i).Columns.Count).End(xlToLeft).Column + 1
    End If
    
    For Each nb In liste
        If i = dernièreligne Then
            Set nouveau = Range(Cells(i, 6), Cells(i, fin)).Find(nb, lookat:=xlWhole)
        Else
            Set nouveau = Range(Cells(i + 1, 6), Cells(dernièreligne, fin)).Find(nb, lookat:=xlWhole)
        End If
        If nouveau Is Nothing Then
            Cells(i, fin) = nb
            Cells(i, fin).Font.ColorIndex = 3
            With Range("Base70")
                Set ici = .Find(nb, lookat:=xlWhole)
                If Not ici Is Nothing Then
                    ici.Interior.ColorIndex = 3
                    'ici.ClearContents
                End If
            End With
            fin = fin + 1
        Else
            Cells(i, nouveau.Column) = nb
        End If
    Next nb
Next i
End Sub
 

jeanjacques

XLDnaute Junior
Re : Macro pour transfert et ajout de nombres nouveaux.

Bonjour,

J'essaye de trouver une méthode pour compter le rapport rouge/blanc pour chaque ligne en colonne BY (il y a x nouveau rouge par rapport à y blancs présents AVANT ces nouveaux rouges ) j'ai mis un exemple de calcul en ligne 10.

Merci de votre aide, je ne sais pas si c'est faisable?

Bon WE
 

Fichiers joints

Discussions similaires


Haut Bas