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

[OursOuzbek]

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.

 

[vgendron]

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)

 

[Victor21]

Bonjour OursOuzbek et bienvenue.

Sans macro ni formule ?
Un TCD suffirait :

Edit : Bonjour, vgendron

 

[vgendron]

sinon, par macro

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]

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]

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