Remplir un Tableau a partir d'un autre tableau selon des conditions (VBA)

S

sylvestre09

XLDnaute Nouveau
Bonjour le forum,
je me retourne vers vous car depuis une semaine je cherche a completer mon projet mais je n'y arrive pas voilà grace à un userform j'entre des données dans plusieurs page j'obtiens donc un tableau avec des opérations saisies (plusieurs lignes) j'aimerai qu'a coté de ce tableau qui existe dans chaque onglet faire un autre tableau avec moins de colonne mais qui sépare les montant négatives des montant positives en les classant selon leur date d'echéance je joint un exemple car c'est difficile d'expliquer !! le Rt souhaité est dans la feuille 2 !!! merci de me donner un coup de main non pas en faisant le travail demandé mais en me guidant un peu car je ne suis pas un pro de VBA
Merci a tous !
 

Pièces jointes

  • Exemple.xls
    30.5 KB · Affichages: 245
  • Exemple.xls
    30.5 KB · Affichages: 256
  • Exemple.xls
    30.5 KB · Affichages: 262
Trier par date Trier par votes
S

sylvestre09

XLDnaute Nouveau
Re : Remplir un Tableau a partir d'un autre tableau selon des conditions (VBA)

Bonjour Vorens c'est bon ça fonctionne très bien voilà le nouveau code
Code: 
Public Sub Gestion_Feuilles(occurs As String)
Dim i As Integer, n As Integer, nbcol As Integer
Dim f As Range, celcop As Range, PlageCopie As Range
Dim firstAddress As String
Dim Tablo() As Variant
Dim sh As Worksheet
Dim existe_feuil As Boolean
Dim DerLig As Long
Dim R As String
Dim DateEche As String
Dim Montant As String
Dim taux As String
Dim ValTabResultNeg As Integer
Dim ValTabResultPos As Integer
Dim DebTab As Integer 'N° de la première ligne du tableau
Dim finTab As Integer 'N° de la dernière ligne du tableau
 
 
    With Sheets("Recap")
        Set celcop = .Range("C3", .Cells(3, .Columns.Count).End(xlToLeft))
    End With
    'nombre de données à alimenter = dimension 1 de la variable Tablo
    nbcol = celcop.Columns.Count
    'Teste si la feuille existe
    existe_feuil = False
    For Each sh In Worksheets
        If sh.Name = occurs Then
            existe_feuil = True
            Exit For
        End If
    Next sh
    'Si la feuille n'existe pas, alors création de celle-ci avec nom et titres de colonnes adaptés
    If existe_feuil = False Then
        Sheets.Add Type:=xlWorksheet, After:=Sheets(Sheets.Count)
        celcop.Copy
        With ActiveSheet
            .Paste Destination:=.Range("C3")
            .Name = occurs
        End With
        Application.CutCopyMode = False
    End If
    'D'après l'aide en ligne de la méthode Find
    With liste
        Set f = .Find(occurs, LookIn:=xlValues)
        If Not f Is Nothing Then
            firstAddress = f.Address
            Do
                n = n + 1
                ReDim Preserve Tablo(3 To nbcol + 2, 1 To n)
                'Toutes les cellules de la ligne alimentent Tablo
                For i = 3 To nbcol + 2
                        Tablo(i, n) = f.Offset(0, i - 6)
                Next i
                Set f = .FindNext(f)
            Loop While Not f Is Nothing And f.Address <> firstAddress
        End If
    End With
    'Alimentation de la feuille
 
    With Sheets(occurs)
        Set PlageCopie = .Range("C4", .Range("C4").Offset(UBound(Tablo, 2) - 1, UBound(Tablo, 1) - 3))
        PlageCopie.Value = Application.Transpose(Tablo)
        For i = 1 To UBound(Tablo, 2)
            .[D4].Offset(i - 1) = Tablo(4, i)
            .[E4].Offset(i - 1) = Tablo(5, i)
        Next i
        DerLig = PlageCopie.SpecialCells(xlCellTypeLastCell).Row
    End With
 
    'Réinitialisation de la variable Tablo
    Erase Tablo
 
    Module2.test (occurs)
 
 
End Sub
(source daniel.c) par contre j'ai une autre question ^^ en fait comme j'aimerai creer un bouton pour dans l'onglet "feuil1" qui permet de remplir le tableau pret emprunt et un autre bouton qui permet de le vider
Code: 
Sub test(occurs As String)
    Dim c As Range, Ctr As Double, x As Range
    Dim Ligne As Long, LigneDeb As Long, LigneCred As Long
    Dim Min As Date, Dico As Object
  
    
    With Sheets(occurs)
    Ligne = 2
    Set Dico = CreateObject("Scripting.Dictionary")
         For Each c In .Range(.[E4], .Cells(Rows.Count, 5).End(xlUp))
           If Not Dico.exists(DateSerial(Year(c.Value), Month(c.Value), 1)) Then
             Dico.Add DateSerial(Year(c.Value), Month(c.Value), 1), _
                 DateSerial(Year(c.Value), Month(c.Value), 1)
         End If
    Next c
    .[AH:AH].ClearContents
    i = 0
    For Each Item In Dico.items
        i = i + 1
        .Cells(i, "AH") = Item
    Next Item
    .[AH:AH].Sort .Range("AH1"), xlAscending, Header:=xlNo
    For Each x In Range(.[AH1], .Cells(Rows.Count, "AH").End(xlUp))
        Ctr = 0
        Ligne = Ligne + 2
        .Cells(Ligne, 40) = DateSerial(Year(x.Value), Month(x.Value), 1)
        .Cells(Ligne, 40).NumberFormat = "mmm-yyyy"
        LigneDeb = Ligne
        LigneCred = Ligne
        For Each c In Range(.[E4], .Cells(Rows.Count, 5).End(xlUp))
            If DateSerial(Year(c.Value), Month(c.Value), 1) = .Cells(Ligne, 40) Then
                If c.Offset(, 2) > 0 Then
                    .Cells(LigneCred, "AO") = .Cells(c.Row, 3)
                    .Cells(LigneCred, "AP") = .Cells(c.Row, 5)
                    .Cells(LigneCred, "AR") = .Cells(c.Row, 8)
                    .Cells(LigneCred, "AQ") = .Cells(c.Row, 7)
                    Ctr = Ctr + .Cells(c.Row, 7)
                    LigneCred = LigneCred + 1
                Else
                    .Cells(LigneDeb, "AJ") = .Cells(c.Row, 3)
                    .Cells(LigneDeb, "AK") = .Cells(c.Row, 5)
                    .Cells(LigneDeb, "AM") = .Cells(c.Row, 8)
                    .Cells(LigneDeb, "AL") = .Cells(c.Row, 7)
                    Ctr = Ctr + .Cells(c.Row, 7)
                    LigneDeb = LigneDeb + 1
                End If
            End If
        Next c
        .Cells(Ligne + 1, 40) = Ctr
        .Cells(Ligne + 1, 40).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
        Ligne = Application.Max(LigneCred, LigneDeb)
    Next x
    .[AH:AH].ClearContents
    
    End With
End Sub
j'ai creer un bouton et je lui est affecter ce code mais ca bloque au niveau de
Code: 
With Sheets(occurs)
pourtant toutes les macro sont de type Public !! peux tu me dire pk il reconnait pas la onglets occurs (j'en est aussi besoin pour creer un bouton qui annule des opérations donc j'aurai vrmt besoin de recommencer avec with sheets occurs !
 
Vote positif 0 Vote négatif
V

Vorens

XLDnaute Occasionnel
Re : Remplir un Tableau a partir d'un autre tableau selon des conditions (VBA)

ta variable occurs est affectée dans une autre macro et est recupérée dans celle ci via le

Code: 
ublic Sub Gestion_Feuilles(occurs As String)

Si tu n'affecte pas de valeur a occurs quand tu lance seulement cette macro cela ne va pas fonctionner.

En un rapide coup d'oeil c'est a quoi je pence. si c'est pas sa il me faut le message d'erreur lorsque le code d'arrête sur cette ligne.
 
Vote positif 0 Vote négatif
S

sylvestre09

XLDnaute Nouveau
Re : Remplir un Tableau a partir d'un autre tableau selon des conditions (VBA)

Bonjour Vorens
je te joint un fichier pour t'expliquer !
en cliquant sur le bouton 2 de l'onglet "feuil1" ensuite sur le premier choix du userform et grace a l'inputbox ou on entre la reference de l'opération celle si doit se supprimer alors j'ai deja plusieurs probleme là :
1 le bouton annuler de l'inputbox ne fonctionne pas
2 la fonction with sheets(occurs) ne marche pas
3 je veux seulement supprimer les cellules de la colonne A jusqu'a la colonne Q et non pas toute la ligne
Help please
 

Pièces jointes

  • Classeur11111.xls
    105.5 KB · Affichages: 61
  • Classeur11111.xls
    105.5 KB · Affichages: 64
  • Classeur11111.xls
    105.5 KB · Affichages: 66
Vote positif 0 Vote négatif
V

Vorens

XLDnaute Occasionnel
Re : Remplir un Tableau a partir d'un autre tableau selon des conditions (VBA)

Re,


Premier point pour commencer, lorsque je prend ton fichier je clic sur le bouton 2, puis je clic sur "annuler une opération" paf sa bug

La raison => With Sheets(recap) Ici recap = une variable avec cette syntaxe et vu que nul part on lui attribue une valeur, bah sa plante puisque on fait référence a rien du tout.

Il faut savoir que dans le cas With Sheets(recap) => recap = variable

si tu veux faire référence directement à une feuille excel il faut l'écrire comme sa

With Sheets("recap") => les "" sont très important, tu ne peut ecrire du texte sans "" dans vba (nul par en prog d'ailleur)


Pour les autres prob je suis entrain de look
 
Vote positif 0 Vote négatif
V

Vorens

XLDnaute Occasionnel
Re : Remplir un Tableau a partir d'un autre tableau selon des conditions (VBA)

Re,


Pour With Sheets(occurs) c'est le même probleme. Regarde, quand tu exécute le code, la ligne ce met en jaune et t'as une fenêtre qui s'ouvre. Tu clic sur Débogage puis met ton curseur sur la variable occurs et tu va voir une fenetre avec dedans occur = ""
se qui veux dire que tu essais de faire une action sur rien du tout. il faut affecter uen valeur dans la variable occur. Sur quelle feuille c'est sensé agir ?
 
Vote positif 0 Vote négatif
V

Vorens

XLDnaute Occasionnel
Re : Remplir un Tableau a partir d'un autre tableau selon des conditions (VBA)

Pour le "pourquoi sa efface pas ma ligne"

J'ai fait comme sa et sa efface nickel

Code: 
If occurs = "" Then occurs = "Recap"

toto = Sheets(occurs).Range("C:C").Find(what:=Ref)


If toto Is Nothing Then

Else

toti = toto.Row

Sheets(occurs).Select

Rows(toti & ":" & toti).Select
Selection.Delete Shift:=xlUp


End If

C'est a la place de ta boucle qui cherche la valeur de la référence dans le userForm

Aussi:

3 je veux seulement supprimer les cellules de la colonne A jusqu'a la colonne Q et non pas toute la ligne
Cliquez pour agrandir...

sa c'est pas possible, enfin si c'est possible mais pas directement.

Pour effacer les ligne seulement de A à Q faudra l'écrire comme sa

Code: 
If occurs = "" Then occurs = "Recap"

Set toto = Sheets(occurs).Range("C:C").Find(what:=Ref)


If toto Is Nothing Then

Else

toti = toto.Row

Sheets(occurs).Select

Range("A" & toti & ":" & "Q" & toti).Select
Selection.ClearContents




End If



End Sub

Le truc c'est que comme as va y avoir un blanc dans ton tableau donc y faudra faire un truc qui remonte d'un cran le reste du tableau (pas bien dire je te laisserais le faire). En cas de prob tu me sonne
 
Vote positif 0 Vote négatif
V

Vorens

XLDnaute Occasionnel
Re : Remplir un Tableau a partir d'un autre tableau selon des conditions (VBA)

Re,


Dans ce cas il faut remplacer

Code: 
If occurs = "" Then occurs = "Recap"

Il faut faut faire une boucle qui parcourt toute les feuilles comme pour l'autre macro. La j'ai "hardcodé" le nom de la feuille pour être sur que tout le reste fonctionne mais il te suffis juste de rendre le nom de la feuille dynamique.
 
Vote positif 0 Vote négatif
V

Vorens

XLDnaute Occasionnel
Re : Remplir un Tableau a partir d'un autre tableau selon des conditions (VBA)

Muarf, le code que j'ai vu précédemment n'est sup a ce que fais un débutant =)

Non mais plus sérieusement, t'as compris ce qui allais pas dans ton code il y a quelque jours ? La le problème c'est qu'on impose le nom de la feuille par

Code: 
If occurs = "" Then occurs = "Recap"

Donc faut faire en sorte qu'il le face pour toute les feuille (sauf la 1 si j'ai bien compris) donc imaginons un code de ce style.

Code: 
Dim sh As Worksheet


For Each sh In Worksheets

If sh.Name <> "Feuil1" Then

'Ton code qui efface ici

End If

Next

Ce code parcours toute les feuilles du classeur sauf la feuille 1. Tu ajoute ensuite ton code qui fait l'action que tu veux ou y'a le commentaire. Apres il faudra surement l'adapter à ta solution mais je pense que c'est ce que tu recherche.
 
Vote positif 0 Vote négatif
S

sylvestre09

XLDnaute Nouveau
Re : Remplir un Tableau a partir d'un autre tableau selon des conditions (VBA)

:) je t'ai dit que je cherche tjr sur la toile j'essaye de comprendre et d'adapter ;)
ok mais si j'ai 2 feuilles sur lesquelles je ne veux pas executer la macro je fait des cases ?
 
Vote positif 0 Vote négatif
V

Vorens

XLDnaute Occasionnel
Re : Remplir un Tableau a partir d'un autre tableau selon des conditions (VBA)

Re,

Dans ce cas tout simplement comme sa
Code: 
Dim sh As Worksheet


For Each sh In Worksheets

If sh.Name <> "Feuil1" And sh.Name <> "Feuil2" Then

sh.Range("A1").Value = 2

End If

Next

Tu ajoute une condition dans le test avec l'autre feuille (sa va bien que si t'as que deux feuilles) si il commence à y avoir trop d’exception effectivement faudra envisager le case.

Si non j'ai just fait une correction sur le code. ici

Code: 
sh.Range("A1").Value = 2

Le code met un 2 dans la cellule A1 de toute les feuilles sauf les deux citées dans le test if. le sh. veux dire que l'action se fait sur la feuille "en cours".

Voila pour cette partie. si t'as d'autres questions hésite pas. (Auj je suis overbook donc pour ce qui est des questions de compréhension ou de syntaxe y'a pas de soucis mais j'aurais pas trop le temps de faire une solutions complète).
 
Vote positif 0 Vote négatif

Discussions similaires

chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Affichage des résultats dans un tableau selon des conditions
Réponses
13
Affichages
293
chaelie2015
chaelie2015
B
  • Question
XL 2016 Recherchez des valeurs et copiez-les dans un autre tableau en fonction de certaines conditions
Réponses
4
Affichages
340
bossman_16
B
B
  • Question
Microsoft 365 Bon de commande avec recapitulatif des lignes saisies sur une autre feuille
Réponses
1
Affichages
154
djidji59430
djidji59430
M
  • Question
Microsoft 365 Construction d'un tableau selon 2 critères en VBA
Réponses
6
Affichages
210
merinos
merinos
B
  • Question
XL 2016 VBA formulaire incrémenter un N° de facture selon l'année(mais dates sur deux colonnes)
Réponses
4
Affichages
230
badduke
B
H
  • Résolu(e)
Microsoft 365 Remplir un tableau récap à partir d'une base de données, avec 2 critères
Réponses
7
Affichages
591
dysorthographie
dysorthographie
M
  • Résolu(e)
Microsoft 365 VBA pour transformer une plage en tableau + Générer un tableau de synthèse
Réponses
10
Affichages
330
Merlin258413
M
F
  • Question
XL 2019 Extraire des lignes suivant somme des colonnes pour alimenter un autre tableau
Réponses
1
Affichages
218
fanfan38
fanfan38
M
  • Résolu(e)
Power Query Convertir un fichier PdF en Excel et restitution d'un état de synthèse
Réponses
10
Affichages
450
Merlin258413
M
L
  • Résolu(e)
Microsoft 365 Recherche d'un montant dans un tableau structuré selon plusieurs critères
Réponses
2
Affichages
256
Leguyl
L

Membres actuellement en ligne

6 membres et 76 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 177
Messages
2 085 971
Membres
103 073
dernier inscrit
MSCHOE16