Récuperation spéciale de données

[jacky49]

Bonjour le Forum,
je voudrais essayé de récupérer des données par rapport à une date de traitement et concaténer dans une même cellules les défauts. J'ai mis un exemple dans le fichier joins en espérant avoir été assez explicite, j'ai réussi à concaténér les défauts, mais le problème, c'est que les cellules vides ne doivent pas apparaitres
merci
jacky

 

[Bebere]

Re : Récuperation spéciale de données

bonjour Jacky
mis une variable publique Ck pour colonne K et un code pour l'initialiser
changer dans le code et corrigé quelques fautes
tu peux ajouter des colonnes avant K
si cela t'intéresse, un userform pour gérer la feuille année

une question qui s'addresse à tous
depuis que j'ai fait un copier/coller des données de la feuille année(donc de excel2007 à 2003)
le code qui est en commentaire dans IniTbl,me donne une erreur
avec la boucle pas de problème

à bientôt

 

[jacky49]

Re : Récuperation spéciale de données

Bonjour Bebere,

j'ai une erreur quand je me sers de l'usf dans le code Sub Defautsans doublon à l'endroit que j'ai mis le texte en jaune mais je l'ai que lorsque je choisis la date de traitement du 13 ( est ce que c'est parce qu'il y a qu'une seule date qui correspond)
et autrement, oui un USF pour traiter la feuille année m'interresse
merci beaucoup
jacky

Public Sub DefautSansDoublon(NomF As String)
    Dim Tbl, X, J As Long, A As Integer, TotalA As Integer, Ligne As String    ', Nomf As String

    Set MonDico = CreateObject("Scripting.Dictionary")
    'Nomf = "RécapDéfaut"

    With Worksheets(NomF)
        L = .Range("G65536").End(xlUp).Row
        Tbl = .Range("G2:G" & L)
    End With

   [COLOR="#FFFF00"] For J = 1 To UBound(Tbl)[/COLOR]
        If InStr(Tbl(J, 1), ",") > 0 Then
            L = J
            X = Split(Tbl(J, 1), ",")

            Set MonDico = CreateObject("Scripting.Dictionary")

            For i = 0 To UBound(X, 1)
                If Not MonDico.Exists(Mid(X(i), InStr(X(i), " ") + 1)) Then
                    MonDico.Add Mid(X(i), InStr(X(i), " ") + 1), Mid(X(i), InStr(X(i), " ") + 1)
                End If
            Next i

            For Each Item In MonDico.items

                For i = 0 To UBound(X, 1)
                    If Mid(X(i), InStr(X(i), " ") + 1) = Item Then
                        A = Mid(X(i), 1, InStr(X(i), " ") - 1)
                        TotalA = TotalA + A
                        If b = "" Then b = Mid(X(i), InStr(X(i), " "))
                    End If
                Next i
                If Ligne = "" Then
                    Ligne = TotalA & b
                Else
                    Ligne = Ligne & "," & TotalA & b
                End If
                b = "": TotalA = 0

            Next Item

            With Worksheets(NomF)
                .Range("G" & L + 1) = ""
                .Range("G" & L + 1) = Ligne
            End With

            Ligne = ""

        End If

    Next J

End Sub

 

[Bebere]

Re : Récuperation spéciale de données

Jacky
je remet le fichier car j'ai fait un nettoyage dans les déclarations de variables des modules
si tu veux mettre du code ici,il faut 'Aller en mode avancé' et cliquer sur # et tu insères le code entre les 2 bornes
tu positionnes le curseur avant
à bientôt

 

[jacky49]

Re : Récuperation spéciale de données

re bebere,

j'ai un problème car lorsque je clic sur une date , il me trie mon tableau avec les lignes d'entete ?
merci
jacky

 

[Bebere]

Re : Récuperation spéciale de données

bonjour Jacky
n'oublie pas qu'une ligne a été ajouté,ligne2 qui doit rester vide

 

[jacky49]

Re : Récuperation spéciale de données

Bonjour le forum, Bébere,

oui, je viens de refaire un essai au travail et j'ai le même problème, j'ai bien laisser la ligne 2 vide et quand j'ai appelé l'usf, j'ai choisi une date puis recap defaut et la il m'a mis un bug , je suis retourné sur la feuille année et la j'ai vu qu'il m'avait trier la ligne 3 des titre avec
je te rejoins le fichier sur lequel j'ai vu l'erreur
merci beaucoup
jacky

 

[Bebere]

Re : Récuperation spéciale de données

Jacky
pas de problème de mon côté
comme tu es sous 2007,enregistre une macro,pour que je voye la syntaxe
l'usfajout est commencé,tu peux ajouter des données
pour les défauts,tu choisis un défaut et tu mets le nbre dans une des textbox
tu peux répéter l'opération choix,entrer un nbre
les listes sont dans feuille listes
tu fais tes remarques

 

[jacky49]

Re : Récuperation spéciale de données

Bonjour Bebere,

Je viens d'essayer le fichier que tu as mis et avec celui-ci je n'ai pas de bug.
l'usf ajouter des données à un problème, le type de pièces n'est pas mis dans la feuille ,ni la teinte ,et autrement,dans l'usf , la base de donnée , je pourrais mettre les teintes par rapport aux différentes pièces, c'est à dire que si je choisis par ex A55 Becquet, j'aurais toute les teintes qui vont avec cette pièces .
pour le code , le voici

Sub Tridefaut()
'
' Tridefaut Macro
'

'
    Range("A1:G77").Select
    ActiveWindow.SmallScroll Down:=-75
    ActiveWorkbook.Worksheets("RécapAnnée").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RécapAnnée").Sort.SortFields.Add Key:=Range( _
        "B2:B77"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("RécapAnnée").Sort.SortFields.Add Key:=Range( _
        "C2:C77"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("RécapAnnée").Sort
        .SetRange Range("A1:G77")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("C12").Select
End Sub

merci
jacky

 

[Bebere]

Re : Récuperation spéciale de données

Jacky
les listes qui sont utilisées dans les combobox,listbox viennent de la feuille listes
tu choisis un type de pièce dans la combobox et tu as la ou les teintes correspondantes
pas compris l'explication avec les teintes

tu ajoutes la partie colorée +2
extrait du code du bouton valider

       For i = 3 To 8
            If Me("TextBox" & i).Value <> "" Then .Cells(L, i[COLOR="#FF0000"] + 2[/COLOR]).Value = CDbl(Me("TextBox" & i).Value)
        Next

dis moi le tri que tu veux dans les feuilles récap

dans code TriDefaut ces 2 lignes sont inutiles
Range("A1:G77").Select
ActiveWindow.SmallScroll Down:=-75

 

[jacky49]

Re : Récuperation spéciale de données

re bebere,

pour les teintes des pièces, c'est que par ex pour le A55 Becquet, je n'ai pas que les teintes qui sont dans la liste, j'en ai 12 exactement et donc ma question etait puis je ajouté a la liste des teintes ou bien est ce que la liste est constitué au fur et a mesure
. Pour le code tridefaut, en fait je cherche à ranger par date de traitement puis par type de pièces .
autrement, j'ai ajouté le +2 et c'est nickel
merci
jacky

 

[Bebere]

Re : Récuperation spéciale de données

bonjour Jacky
tu peux ajouter à la liste et on peut le prévoir par code
si il faut prévoir d'autres ajouts dis le
en fait tu peux avoir ajouter,modifier,supprimer
à toi de dire ce que tu veux

autre chose
quelle action faut il faire si il n'y a pas de défaut
effacer les données,les laisser avec un message dans la feuille
avec la date du 17/01 et defautsansr5 c'est le cas


à bientôt

 

[jacky49]

Re : Récuperation spéciale de données

Re Bebere,

en fait comme dans recap année,il y a tout confondu, le mieux est de ne pas les afficher dans la feuille .
autrement,pour les teintes, je les ajouterais manuellement à la liste ce sera plus simple
merci
jacky

 

[jacky49]

Re : Récuperation spéciale de données

Re Bebere,

je viens de voir que j'ai dit une bétise, il fut laisser les données même s'il est n'ont pas de défaut mais peut-être ajouté comme tu dis un commentaire, peut être "félicitations à tous"
merci
jacky

 

[Bebere]

Re : Récuperation spéciale de données

bonjour Jacky

complété et corrigé le code
ajout type et teinte y compris
nous verrons à l"usage
à bientôt

 

[jacky49]

Re : Récuperation spéciale de données

Bonsoir le forum,Bébere,

j'ai fais des essais sur le fichier et je n'ai rencontré aucun problème et je te remercie ^pour ce que tu as fait, c'est super
encore merci beaucoup et je te tiendrais informé des évolutions à l'usage.
jacky