Macro copie si valeur avec 40000 lignes et 250 colonnes

[flint6593]

Bonjour à tous,
Je viens chercher vos lumières!!

Je suis actuellement bloqué sur un Excel, je vous explique:

- Dans la colonne A j'ai des références,
- Les valeurs en gras sont les références majeures et celles qui sont en suivant sont les références des composants,
- A droite des références de composants (non gras), j'ai des validités sur 249 colonnes.
- J'aimerais que chaque validité de composants remontent sur la ligne de la référence en gras supérieure.

Normalement j'aurais fait ça très rapidement avec un tableau croisé dynamique, mais sur 250 colonnes je n'y arrive pas.
Est-ce que vous auriez des idées??? excel, macro, formule??? Je me débrouille pas mal en macro.

Je vous met un fichier exemple,
Merci pour votre aide!!!
Flint!

 

[titiborregan5]

Re : Macro copie si valeur avec 40000 lignes et 250 colonnes

Bonjour Flint, le forum,

ce que j'aurais fait comme code :
1/ insérer une colonne en A
2/ détecter si c'est en gras et mettre un x en A
3/ si non en gras et avec une valeur en B:IR --> copier coller la valeur sur la ligne avec le x (avec end(xlup))...

Le 1 et 2 c'est facile, le 3 comme je ne gère pas les tableaux ça risque d'être long...

Dis-moi si tu as besoin d'aide supplémentaire...

Bon courage...

Tibo

 

[flint6593]

Re : Macro copie si valeur avec 40000 lignes et 250 colonnes

Bonjour!!

Merci pour cette réponse rapide!!
Moi aussi je suis un peu bloqué car il peut y avoir beaucoup de références de composants et donc de validités...
Avec le copie/colle (que j'ai essayé), ça écrase la valeur déjà présente d'une autre référence...

Je vais essayer de faire des boucles sur les 40000 lignes si gras et des mini boucles sur les 250 colonnes...
Mais je ne sais pas ce que ça va donner... :S

Merci en tous cas!!

 

[Robert]

Re : Macro copie si valeur avec 40000 lignes et 250 colonnes

Bonjour le fil, bonjour le forum,

Peut-être comme ça :

Public Sub Macro1()
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim i As Integer 'déclare la variable i (Incrément)
Dim cg() As Variant 'déclare le tableau de variables indexées cg (Cellules en Gras)
Dim prm As Range 'déclare la variable prm (Plage des Références Majeures)

Set o = Sheets("Feuil1") 'définit l'onglet o
dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne dl de la colonne 1 (=A) de l'onglet o
Set pl = o.Range("A1:A" & dl) 'définit la plage pl
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    If cel.Font.Bold = True Then 'condition si la cellule est avec une police "gras"
        ReDim Preserve cg(i) 'redimensionne le tableau de variable cg
        cg(i) = cel.Row 'attribue le numéro de ligne à la variable indexée cg(i)
        i = i + 1 'incrémente i
    End If 'fin de la condition
Next cel 'prochaine cellule de la boucle
ReDim Preserve cg(i) 'redimensionne le tableau
cg(i) = dl + 1 'attribue la dernière ligne du tableau plus une à la variable indéxée cg(i)
For i = LBound(cg) To UBound(cg) - 1 'boucles sur toutes les variables sauf la dernière (toutes les ligne grises)
    Set prm = o.Range(o.Cells(cg(i) + 1, 2), o.Cells(cg(i + 1) - 1, 251)) 'définit la plage prm comprise entre les lignes grises à partir de la colonne 2 jusq'à la colonne 251
    For Each cel In prm 'boucle sur toutes les cellules cel de la plage prm (toutes les lignes grises
        If cel.Value <> "" Then 'condition : si la cellule n'est pas vide
            o.Cells(cg(i), cel.Column).Value = cel.Value 'récupère la valeur de la cellule dans la ligne grise
            cel.Value = "" 'efface le contenu de la cellule
        End If 'fin de la condition
    Next cel 'prochaine celllule de la boucle
Next i 'prochaine variable indéxée de la boucle
End Sub

Attention, le code repère les valeur en Gras dans la colonne A. Bien vérifier que seules les références majeures le sont...

 

[Robert]

Re : Macro copie si valeur avec 40000 lignes et 250 colonnes

Bonjour le fil, bonjour le forum,

Pour éviter la vérification des valeur en Gras, ce nouveau code repère les valeurs en gras avec en plus le fond gris :

Public Sub Macro1()
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim i As Integer 'déclare la variable i (Incrément)
Dim cg() As Variant 'déclare le tableau de variables indexées cg (Cellules Grises)
Dim prm As Range 'déclare la variable prm (Plage des Références Majeures)

Set o = Sheets("Feuil1") 'définit l'onglet o
dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne dl de la colonne 1 (=A) de l'onglet o
Set pl = o.Range("A1:A" & dl) 'définit la plage pl
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    If cel.Interior.Color = 14277081 And cel.Font.Bold = True Then 'condition si la cellule est de couleur grise et avec une police "gras"
        ReDim Preserve cg(i) 'redimensionne le tableau de variable cg
        cg(i) = cel.Row 'attribue le numéro de ligne à la variable indexée cg(i)
        i = i + 1 'incrémente i
    End If 'fin de la condition
Next cel 'prochaine cellule de la boucle
ReDim Preserve cg(i) 'redimensionne le tableau
cg(i) = dl + 1 'attribue la dernière ligne du tableau plus une à la variable indéxée cg(i)
For i = LBound(cg) To UBound(cg) - 1 'boucles sur toutes les variables sauf la dernière (toutes les ligne grises)
    Set prm = o.Range(o.Cells(cg(i) + 1, 2), o.Cells(cg(i + 1) - 1, 251)) 'définit la plage prm comprise entre les lignes grises à partir de la colonne 2 jusq'à la colonne 251
    For Each cel In prm 'boucle sur toutes les cellules cel de la plage prm (toutes les lignes grises
        If cel.Value <> "" Then 'condition : si la cellule n'est pas vide
            o.Cells(cg(i), cel.Column).Value = cel.Value 'récupère la valeur de la cellule dans la ligne grise
            cel.Value = "" 'efface le contenu de la cellule
        End If 'fin de la condition
    Next cel 'prochaine celllule de la boucle
Next i 'prochaine variable indéxée de la boucle
End Sub

 

[flint6593]

Re : Macro copie si valeur avec 40000 lignes et 250 colonnes

Robert => MERRRCCCCIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Tu viens de me sauver plus d'une journée de boulot avec des risques d'erreus!!!
Encore merci, c'est vraiment super!!!!!!!!!!

Bonne journée!!!!