XL 2010 Archivage données tableau dans un autre avec conditions

A

arnaudbu

XLDnaute Occasionnel
Bonjour, voici mon fichier.

Je bosse sur l'onglet SAISIE. Je dois pouvoir archiver les données du tableau (D13:G19,D21:D26) de toutes les lignes contenant un 1 en colonne H mais aussi la valeur de SAISIE!A9.

La sauvegarde se fera dans l'onglet DONNEES sur la ligne correspondant à la date de SAISIE!A3, du poste SAISIE!A7.

Chaque valeur du tableau se retrouvera sous le nom correspondant. J'espère être clair.

Bon je bosse un peu sur le code, mais je galère et du coup, j'ai préféré pas mettre mes tentatives abordées dans le fichier.

Merci,

@+
 

Pièces jointes

  • forum.xls
    216 KB · Affichages: 40
Trier par date Trier par votes
A

arnaudbu

XLDnaute Occasionnel
Re : Archivage données tableau dans un autre avec conditions

Bon, j'en suis ici: réussi à faire ma boucle sur les lignes à vérifier, mais je bute à trouver quelle cellule est remplie dans le tableau, puis la copie dans l'autre feuille au bon endroit.

Code: 
Sub Archivage()

'Désactive la mise à jour écran
Application.ScreenUpdating = False

Dim Date_Jour As Range, Equipe As Range, Poste As Range, Nom As Range
Dim t() As Variant, i As Integer
Dim MSG As Long

'Liste des lignes à contrôler si remplies
t = Array(13, 14, 15, 16, 17, 18, 19, 21, 22, 23, 24, 25, 26)

With Sheets("Saisie")

    'Contrôle si effectif mini présent
    If .Range("R18").Value < "10" Then

        'Message erreur si effectif mini non atteint
        MSG = MsgBox("L'effectif n'est pas complet, vérifier la saisie dans le tableau.", vbExclamation, "Effectif incomplet")
        
        'Fin Macro
        Exit Sub
    
        Else
        
        'Défini Date à archiver et quelle équipe et quel poste
        Set Date_Jour = .Range("A2")
        Set Poste = .Range("A7")
        Set Equipe = .Range("A9")
        
        'Boucle sur les lignes à archiver si effectif présent
        For i = LBound(t) To UBound(t)
       
            If .Range("H" & t(i)).Value = "1" Then
                Set Nom = .Range("A" & t(i))
            [B]BLOQUE ICI[/B]
            End If
         
        Next i
    
    End If
    
End With

End Sub
 
Vote positif 0 Vote négatif
T

thebenoit59

XLDnaute Accro
Re : Archivage données tableau dans un autre avec conditions

Bonjour Arnaud.

J'ai ajouté une somme dans la colonne C de la feuille Saisie pour que ce soit plus simple.
Je te laisse étudier le code.
 

Pièces jointes

  • arnaudbu - Archivage données tableau dans un autre avec conditions.xls
    237 KB · Affichages: 46
Vote positif 0 Vote négatif
A

arnaudbu

XLDnaute Occasionnel
Re : Archivage données tableau dans un autre avec conditions

Au top, un énorme pas en avant. Il y a juste la variable EQUIPE qui n'est pas sauvegardée. Mais aussi le soucis c'est que si je déplace les nom ou en ajoute sur la feuille données, les valeurs doivent toujours aller dans la bonne colonne.

Sinon, c'est nickel. Merci.
 
Vote positif 0 Vote négatif
T

thebenoit59

XLDnaute Accro
Re : Archivage données tableau dans un autre avec conditions

On va faire différemment alors :

Code: 
Sub Archivage_Benoit()
'Déclaration des variables
Dim Jour As Date
Dim Poste As String
Dim Equipe As String
Dim Ligne As Long, Colonne As Long
Dim d As Object
Dim t

'On vérifie si l'effectif nécessaire est obtenu
If Sheets("Saisie").[r18] < 10 Then
    MsgBox "L'effectif n'est pas complet", 16
    Exit Sub
End If

'On enregistre le jour, le poste et l'équipe
With Sheets("Saisie")
    Jour = .[a3]
    Poste = .[a7]
    Equipe = .[a9]
End With

'On détermine la ligne où enregistrer les valeurs
With Sheets("Donnees")
    For i = 2 To .[a65000].End(xlUp).Row
        If .Cells(i, 1).Value & .Cells(i, 2).Value = Jour & Poste Then
            Ligne = i
            Exit For
        End If
    Next i
End With

'On vérifie qu'une ligne a bien été trouvée
If Ligne = 0 Then
    MsgBox "Pas de ligne trouvée", 16
    Exit Sub
End If

'On enregistre les numéros de colonnes correspondant aux noms
With Sheets("Donnees")
    Set d = CreateObject("Scripting.Dictionary")
    For i = 4 To .[a1].End(xlToRight).Column
        d(.Cells(1, i).Value) = i
    Next i
End With

'On enregistre les noms et postes dans un tableau
t = Sheets("Saisie").Range("a13:c26").Value

'On boucle le tableau
With Sheets("Donnees")
For i = LBound(t) To UBound(t)
    If t(i, 3) <> "" Then
        Colonne = d(t(i, 1))
        .Cells(Ligne, Colonne).Value = t(i, 3)
    End If
Next i

'On note l'équipe
.Cells(Ligne, 3).Value = Equipe
End With
End Sub

J'ai ajouté l'équipe à noter dans la colonne C de ta feuille Données.
Maintenant nous bouclons pour les remplaçants et titulaires, avec recherche de la colonne pour chaque nom, comme ça tu peux modifier facilement.
Pour les colonnes, que tu en ajoutes ou enlèves, ce n'est pas un soucis car on recherche la dernière colonne pour alimenter l'index.
 
Vote positif 0 Vote négatif
T

thebenoit59

XLDnaute Accro
Re : Archivage données tableau dans un autre avec conditions

Peut-être que le nom n'est pas repris dans la feuille Données.
On peut tester si la valeur existe, si ce n'est pas le cas on passe à la ligne suivante.

Code: 
'On boucle le tableau
With Sheets("Donnees")
For i = LBound(t) To UBound(t)
    If t(i, 3) <> "" Then
        If d.exists(d(t(i, 1)) Then
            Colonne = d(t(i, 1))
            .Cells(Ligne, Colonne).Value = t(i, 3)
        End If
    End If
Next i
 
Vote positif 0 Vote négatif
A

arnaudbu

XLDnaute Occasionnel
Re : Archivage données tableau dans un autre avec conditions

J'ai corrigé, dis moi si OK ?

Code: 
'On boucle le tableau
With Sheets("Donnees")
For i = LBound(t) To UBound(t)
    If t(i, 3) <> "" Then
    If d.exists(t(i, 1)) Then
        Colonne = d(t(i, 1))
        .Cells(Ligne, Colonne).Value = t(i, 3)
        End If
    End If
Next i
 
Dernière édition:
Vote positif 0 Vote négatif
A

arnaudbu

XLDnaute Occasionnel
Re : Archivage données tableau dans un autre avec conditions

Dernier truc, je rajoute ce code

Code: 
'On vérifie qu'un enregistrement n'est pas déjà effectué à cet endroit
With Sheets("Donnees")
    If .Cells(i, 3).Value = Poste Then
    MSG = MsgBox("Enregistrement déjà effectué pour cette date et ce poste. Merci de corriger manuellement!", vbExclamation, "Attribution des postes")
    Exit Sub
End If
End With

Après le MsgBox je veux rajouter
.Cells(i, 3).select ou un truc du genre pour afficher si erreur mais ça ne fonctionne pas.
 
Vote positif 0 Vote négatif
T

thebenoit59

XLDnaute Accro
Re : Archivage données tableau dans un autre avec conditions

Je ne comprends pas.
En colonne 3 tu as l'Equipe et non le Poste.
On peut écrire :

Code: 
Sub Archivage_Benoit()
'Déclaration des variables
Dim Jour As Date
Dim Poste As String
Dim Equipe As String
Dim Ligne As Long, Colonne As Long
Dim d As Object
Dim t

'On vérifie si l'effectif nécessaire est obtenu
If Sheets("Saisie").[r18] < 10 Then
    MsgBox "L'effectif n'est pas complet", 16
    Exit Sub
End If

'On enregistre le jour, le poste et l'équipe
With Sheets("Saisie")
    Jour = .[a3]
    Poste = .[a7]
    Equipe = .[a9]
End With

'On détermine la ligne où enregistrer les valeurs
With Sheets("Donnees")
    For i = 2 To .[a65000].End(xlUp).Row
        If .Cells(i, 1).Value & .Cells(i, 2).Value = Jour & Poste Then
            Ligne = i
            Exit For
        End If
    Next i
End With

'On vérifie qu'une ligne a bien été trouvée
If Ligne = 0 Then
    MsgBox "Pas de ligne trouvée", 16
    Exit Sub
End If

'On enregistre les numéros de colonnes correspondant aux noms
With Sheets("Donnees")
    Set d = CreateObject("Scripting.Dictionary")
    For i = 4 To .[a1].End(xlToRight).Column
        d(.Cells(1, i).Value) = i
    Next i
End With

'On vérifie qu'il n'existe pas déjà un enregistrement pour cette date et poste
If Sheets("Donnees").Cells(Ligne, 3).Value <> "" Then MsgBox "Enregistrement déjà effectué pour le " & Jour & " poste " & Poste, 16: Exit Sub

'On enregistre les noms et postes dans un tableau
t = Sheets("Saisie").Range("a13:c26").Value

With Sheets("Donnees")
'On note l'équipe
.Cells(Ligne, 3).Value = Equipe
'On boucle le tableau
For i = LBound(t) To UBound(t)
    If t(i, 3) <> "" Then
        If d.exists(t(i, 1)) Then
            Colonne = d(t(i, 1))
            .Cells(Ligne, Colonne).Value = t(i, 3)
        End If
    End If
Next i
End With

End Sub
 
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
391
chaelie2015
chaelie2015
S
  • Résolu(e)
Microsoft 365 Excel recopier des données d'un tableau dans un autre onglet sans macro
Réponses
5
Affichages
554
Sissou71
S
S
  • Question
XL 2019 Regroupement données dans un tableau
2
Réponses
18
Affichages
668
Shimano
S
L
  • Résolu(e)
XL 2021 Recréer un tableau sur base de certaines données
Réponses
2
Affichages
476
Liowat
L
B
  • Question
XL 2016 Macro système d'archivage d'un tableau dans un autre tableau déroulant
Réponses
2
Affichages
394
babacool22
B
I
  • Question
XL 2019 Suite à une formule, enlever le doublon dans le résultat avec fonction SI
Réponses
2
Affichages
124
IderMTC
I
V
  • Question
XL 2021 Implémenter tableau avec des fichiers mis dans un dossier
Réponses
2
Affichages
199
merinos
merinos
J
  • Question
XL 2013 Obtenir une boucle de liste dans un tableau qui change avec le choix de l'année
Réponses
2
Affichages
290
mapomme
mapomme
J
  • Question
Autres Supprimer une ligne dans une feuille à partir d'une valeur rentrée dasn une cellule d'une autre feuille
2
Réponses
25
Affichages
1 K
jmc78
J
D
  • Résolu(e)
Microsoft 365 Récupérer des données d'un tableau dans un autre avec structure différente
Réponses
6
Affichages
585
Dam71
D

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 28 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 413
Messages
2 088 199
Membres
103 764
dernier inscrit
nissassa