Extraction d'une base de données

[Caninge]

Bonjour à tous et à toutes,

Dans un fichier, j'ai une feuille "Comptes" + une feuille "Recap".
Comment extraire une partie de la feuille "Comptes" pour ma mettre sur la feuille"Recap".
Avec mon fichier vous comprendrez plus aisément ma demande.

Je vous remercie !

CANINGE

 

[mth]

Re : Extraction d'une base de données

Bonsoir caninge,

Tu trouveras en PJ un essai à partir d'un filtre élaboré, et cette macro affectée au bouton "clic":

Sub Macro1()
'pour calculer la dernière ligne du tableau comptes
Dim Derlig As Long
Derlig = Sheets("Comptes").Cells(Rows.Count, 2).End(xlUp).Row
 
 
'nettoyage de l'onglet récap
'un premier with pour effacer les données
With Sheets("Récap")
.Columns("A:I").ClearContents
' ici pour effacer les couleurs
With .Columns("A:I").Interior
.Pattern = xlNone
End With
'ici pour effacer les bordures
With .Columns("A:I").Borders
.LineStyle = xlNone
End With
End With
 
'construction du filtre élaboré
With Sheets("Comptes")
'place en L2 une formule de calcul qui servira de critère
.Range("L2").FormulaR1C1 = "=YEAR(R[1]C[-8])=R1C2"
' sélectionne le tableau, prépare le filtre sur la base du critère, copie le résultat dans l'onglet Récap
.Range("B2:J" & Derlig).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
"L1:L2"), CopyToRange:=Sheets("Récap").Range("A1:I1"), Unique:=False
'efface le contenu de la cellule L2
.Range("L2").ClearContents
End With
 
End Sub

Vois si cela peut t'aider

Très bonne soirée à toi,

mth

Edit: Bonsoir jeted, bonsoir David 🙂 🙂

Péché de gourmandise coté With …

Sans me taper sur les palmes un Jeune et charmant Mentor m’a gentiment soufflé en MP une bien meilleure écriture que voici :
En remplaçant ça :

'un premier with pour effacer les données
With Sheets("Récap")
.Columns("A:I").ClearContents
' ici pour effacer les couleurs
With .Columns("A:I").Interior
.Pattern = xlNone
End With
'ici pour effacer les bordures
With .Columns("A:I").Borders
.LineStyle = xlNone
End With
End With

Par ça :

With Sheets("Récap").Columns("A:I")
  .ClearContents
  .Interior.Pattern = xlNone
  . Borders.LineStyle = xlNone
End With

C'est quand même bien mieux 🙂
Merci jeune homme 🙂
@ +
m

 

[jetted]

Re : Extraction d'une base de données

J'espere que cela peux vous aidez

Sub Macro1()
    Sheets("Récap").Select
    Range("D5").Select
    annee = ActiveCell.Value
    annee = Right(annee, 2)
    'clear
    RowCount = Cells(Cells.Rows.Count, "c").End(xlUp).Row
    Range("B7:j" & RowCount).Delete
    Range("B7").Select
    Sheets("Comptes").Select
    RowCount = Cells(Cells.Rows.Count, "d").End(xlUp).Row
    For i = 6 To RowCount
        Sheets("Comptes").Select
        Range("D" & i).Select
        check = ActiveCell.Value
        check = Right(check, 2)
        If annee = check Then
            ActiveCell.EntireRow.Copy
            Sheets("Récap").Select
            j = Cells(Cells.Rows.Count, "d").End(xlUp).Row
            Range("b" & j + 1).EntireRow.Select
            Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:= _
                                   False, Transpose:=False
            Sheets("Comptes").Select
        End If
    Next
End Sub

 

[david84]

Re : Extraction d'une base de données

Bonsoir Caninge, m🙂, Jetted,

=SI(LIGNES($1:1)<=SOMME(N(ESTNUM(CHERCHE($D$5;ANNEE(Comptes!$D$6:$D$18)))));INDEX(Comptes!B$6:B$18;PETITE.VALEUR(SI(ANNEE(Comptes!$D$6:$D$18)=Récap!$D$5;LIGNE(INDIRECT("1:"&LIGNES(Récap!B$6:B$18))));LIGNES($1:1)));"")&""

A placer en B7 et à tirer vers le bas et la droite.
Valider matriciellement en appuyant simultanément sur Ctrl, Maj et entrée.
A+

 

[BOISGONTIER]

Re : Extraction d'une base de données

Bonsoir,

Voir PJ
Avec le filtre élaboré

http://boisgontierjacques.free.fr/pages_site/FiltreElabore.htm#critereformule

Sub extrait()
    Sheets("Comptes").Range("B2:J1000").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("D1:D2"), CopyToRange:=Range("B6:J6"), Unique:=False
End Sub

JB

 

[Lermiton]

Re : Extraction d'une base de données

Bonsoir tous.

Je pensais proposer une autre macro, mais je m'aperçois à l'instant que la recherche de la dernière ligne du tableau "source" est dépendante de sa conception (existence d'une ligne vide avant la 1ère ligne comptable ou non, de lignes de commentaires sous le tableau, etc... ), et il est trop tard pour corriger, le sommeil m'appelle avec vigueur... Désolé.

Bonne nuit !

 

[Lermiton]

Re : Extraction d'une base de données

Bonjour.

Le sommeil m'ayant fuit, me voici de retour.

Mon problème était le suivant : ne sachant pas quelle serait la conception finale du tableau comptable (position dans la feuille, nombre de colonnes, présence ou non d'une ligne vide avant la 1ère ligne comptable, etc...), je voulais trouver une solution facilement adaptable à tous les cas.

J'ai donc modifié mon code en le fondant sur des constantes dont il suffit de corriger la valeur en fonction de la conception réelle du tableau. La recherche des lignes comptables correspondant à l'année demandée s'arrête dès qu'elle trouve une ligne vide, puisque en principe, il n'y a pas de ligne vide dans une comptabilité.

Voici le code :

Sub Extraire()
    Dim r, x, y, c, i As Integer
    Dim An As String
    Dim ShC, ShR As Worksheet
    Dim Test As Boolean
    
Rem definit le tableau des lignes comptables de la feuille "Comptes"
    Const Lig1C As Integer = 6  ' n° de la 1ère ligne comptable
    Const Col1C As Integer = 2  ' n° de la 1ère colonne comptable
    Const NbCol As Integer = 10 ' nombre de colonnes comptables
    Const ColDate As Integer = 4    ' n° de la colonne des dates d'opération
    
Rem définit le tableau des extractions dans la feuille "Récap"
    Const Lig1R As Integer = 7  ' n° de la 1ère ligne des extractions
    Const Col1R As Integer = 2  ' n° de la 1ère colonne des extractions
    
Rem définit la cellule devant recevoir comme titre l'année de l'extraction
    Const CelTitre = "D5"

Rem définit les feuilles
    Set ShC = ThisWorkbook.Sheets("Comptes")
    Set ShR = ThisWorkbook.Sheets("Récap")

Rem demande l'année à extraire
reprise:
    An = InputBox("Saisissez l'année à extraire en 4 chiffres", "EXTRACTION")
    If An = "" Then
        Exit Sub
    ElseIf Not IsNumeric(An) Then
        MsgBox "Saissez un nombre valide pour l'année à extraire !", 64, "EXTRACTION"
        GoTo reprise
    ElseIf Len(An) <> 4 Then
        MsgBox "Saissez un nombre à QUATRE chiffres pour l'année à extraire !", 64, "EXTRACTION"
        GoTo reprise
    End If

Rem remplit la cellule devant recevoir l'année de l'extraction
    ShR.Range(CelTitre) = "Année" & An

Rem Efface l'ancienne extraction (les données mais pas les mises en formes de la feuille Récap)
    ShR.Rows(Lig1R & ":" & 65536).ClearContents
    
Rem Extrait les lignes voulues
    r = Lig1C - 1
    x = Lig1R - 1
    Do
        r = r + 1
        ' vérifie qu'il y a au moins une cellule non vide dans la ligne
        Test = False
        For c = Col1C To Col1C + NbCol - 1
            If ShC.Cells(r, c) <> "" Then
                Test = True
                Exit For
            End If
        Next
        ' quitte la boucle Do s'il n'y a aucune cellule non vide
        If Test = False Then Exit Do
        ' vérifie la présence d'une date dans la colonne des dates
        If IsDate(ShC.Cells(r, ColDate)) Then
            If Year(ShC.Cells(r, ColDate)) = An Then
                ' copie la ligne si elle correspond à l'année demandée
                x = x + 1
                y = Col1R - 1
                For c = Col1C To Col1C + NbCol - 1
                    y = y + 1
                    ShR.Cells(x, y) = ShC.Cells(r, c)
                Next
            End If
        End If
    Loop
            
Rem Finale
    MsgBox "Il y a " & x - Lig1C & " ligne(s) comptable(s) pour l'année " & An, 64, "EXTRACTION"

End Sub

Je joins le fichier au format Excel 2003

Bonne fin de nuit.

 

[Caninge]

Re : Extraction d'une base de données

Bonjour à tous,

Je vous remercie pour toutes les réponses données.
Je ne comprends pas tout.
J'ai voulu mettre la solution de David (sans macro) mais je n'arrive pas à faire ce qu'il me demande d'effectuer.
Si il pouvait m'envoyer le fichier rectifié (avec les formules dans les cellules !)
Par contre je trouve bien les solutions de BOIS GONTIER
et de Lermiton.(tu iras au lit de bonheur ce soir)

Bien sympas

Je vous remercie .

 

[david84]

Re : Extraction d'une base de données

Bonsoir
ci-joint fichier (ton fichier est en calcul manuel).
A+

 

[Lermiton]

Re : Extraction d'une base de données

Bonsoir.

Tant mieux si les réponses que tu as trouvées ici peuvent t'aider. Pour moi, chercher une réponse à une question posée est un excellent exercice intellectuel, qui éloigne le spectre de la sénilité... Et si en plus ça peut aider quelqu'un, c'est le Pérou !

Oui, le coucher ne va pas tarder ce soir ! Bonne nuit donc.

PS : en toute rigueur, j'aurai du écrire dans ma macro

Const CelTitre As String = "D5"

et non pas

Const CelTitre = "D5"

 

[Caninge]

Re : Extraction d'une base de données

Bonjour à tous,

Finalement j'ai retenu la solution de David.

Je vous remercie tous et bon week-end

CANINGE