VBA - report de valeur avec espacement, dans un tableau sans case vide.

OursOuzbek

XLDnaute Nouveau
Bonjour,

Nouvellement inscrit sur le forum, je viens pour demander des conseils notamment en ce qui concerne la VBA. J'ai de solides bases sur excel, mais en passant au niveau supérieur, à savoir les macros, je me suis heurté à un tout nouveau langage, dont j'ai beaucoup de mal à appréhender la grammaire, n'ayant aucune base en programmation.

Après cette courte introduction, voici mon problème :

je souhaite, à l'aide d'une macro, reporter toutes les valeurs d'une colonne comportant de nombreux trous, dans une colonne n'en ayant plus aucun.

Dans le fichier joint, j'ai recrée une version simplifiée de mon tableau. (le résultat souhaité est en rouge)

D'après ce que j'ai compris de la VBA, il me faudrait une fonction "for each" qui analyserait chaque cellule pour déterminer si elle est vide ( si elle affiche "" en vérité, car elles contiennent toute une formule, qui renvoie, ou non, à une valeur ) et qui copierait la valeur de cellule vers une autre destination, puis décalerait cette destination d'une ligne avant de continuer d'analyser les cellules suivantes.

J'ai parcouru un bouquin (la programmation VBA pour les nuls) , mais malgré mes essais, ma grammaire demeure infructueuse.

Merci d'avance à tous ceux qui m'aiguilleront dans la bonne direction.
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Hello
sans passer par du code..
une formule matricielle (valider la formule avec Ctrl+Maj + Entrée)
en L4
=INDEX($F:$I;PETITE.VALEUR(SI($F:$F<>"";LIGNE($F:$F);"");LIGNES($L$3:L3));COLONNES($L$3:L$3))

et tirer vers la droite et le bas (remettre format standard pour les colonnes M N et O)
 

vgendron

XLDnaute Barbatruc
sinon, par macro
VB:
Sub extraire()
Dim tablo() As Variant

With Sheets("Feuil1")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tablo = .Range("A2:E" & fin).Value
End With

For i = LBound(tablo, 1) To UBound(tablo, 1) - 1
    If tablo(i, 1) <> tablo(i + 1, 1) Then
        For j = LBound(tablo, 1) To i
            If tablo(j, 1) = tablo(i, 1) Then
                SommeEnt1 = SommeEnt1 + IIf(tablo(j, 3) <> "", tablo(j, 3), 0)
                SommeEnt2 = SommeEnt2 + IIf(tablo(j, 4) <> "", tablo(j, 4), 0)
                SommeEnt3 = SommeEnt3 + IIf(tablo(j, 5) <> "", tablo(j, 5), 0)
                If j <> i Then
                    For k = LBound(tablo, 2) To UBound(tablo, 2)
                         tablo(j, k) = ""
                    Next k
                End If
            End If
        Next j
        tablo(i, 3) = SommeEnt1
        tablo(i, 4) = SommeEnt2
        tablo(i, 5) = SommeEnt3
    End If
Next i

With Sheets("Feuil2")
    Application.DisplayAlerts = False
    .Columns("A:E").ClearContents
    .Range("A2").Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
    .Range("A2").Resize(UBound(tablo, 1), UBound(tablo, 2)).AutoFilter Field:=1, Criteria1:="="
    .Range("A2").Resize(UBound(tablo, 1), UBound(tablo, 2)).SpecialCells(xlCellTypeVisible).Delete
     Application.DisplayAlerts = True
End With
End Sub
edit: Hello @Victor21
 

OursOuzbek

XLDnaute Nouveau
Salut,

Merci de cette prompte réponse !

Effectivement, cette solution fonctionne.

Cependant, le but de l'utilisation de la VBA était également de commencer avec un exercice relativement simple pour mieux appréhender la chose et passer ensuite sur des exécutions plus complexes.

(en gros, dans le cas précis, le tableau qui réunit les données sera dans un autre fichier, et la VBA va vite s'avérer indispensable !)


EDIT : j'ai été interrompu entre le moment ou j'ai appuyé sur répondre, et le moment ou j'ai finalement pris le temps d'écrire le message, du coup je n'avais pas vu les autres réponses.

Merci pour vos réponses et pour l'accueil !
 

OursOuzbek

XLDnaute Nouveau
Code:
Sub Reportmemefeuille()

Dim lignedest As Integer
lignedest = 6

For i = 6 To 300
   
    If Cells(i, 14).Value <> "" Then
   
    Cells(lignedest, 21).Value = Cells(i, 14).Value
    Cells(lignedest, 22).Value = Cells(i, 15).Value
    Cells(lignedest, 23).Value = Cells(i, 16).Value
    Cells(lignedest, 24).Value = Cells(i, 17).Value
   
    lignedest = lignedest + 1
   
    End If
   
    Next
   
End Sub


Pour info, je me suis bricolé une petite ligne de code qui fonctionne niquel !

Le sujet est clos pour ma part, merci à tout :)
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas