Travail sur des tableaux

Bonjour,

J'ai besoin de votre aide car je n'arrive à rien.

Je possède un fichier avec 5 onglets :

un onglet "Rapport 1" avec tous le matériel référencé

4 onglets avec le même matériel mais par secteur.

afin de mettre à jour notre base j'ai besoin de croiser ces onglets.

Je dois utiliser la colonne immatriculation pour la recherche.

donc "Rapport 1" immat en colonne "I" et pour les 4 autres immat en colonne "F".

le but est pour chaque ligne de "Rapport 1" de chercher l'immat dans les 4 autres onglets et quand on trouve une correspondance on copie toute la ligne trouvée (texte plus couleur de fond) dans l'onglet "Rapport 1" sur la ligne de la même immat à partir de la colonne "S".

ceci afin de pouvoir comparer et vérifier la cohérence entre notre base et celle des des secteurs.

une autre chose les onglets sont amené à évoluer en terme de longueur.

à l'avance merci pour votre aide qui est toujours très précieuse.

Bonjour,

une précision peut être importante:

je vais voir ensuite pour mettre la mise à jour des onglets à l'ouverture.

je l'ai déjà fait pour un autre fichier donc je devrais m'en sortir mais pour mon poste ci-dessus je cherche et je n'ai toujours pas la solution.

Bonne journée à tous

J'ai oublié de préciser si il n'y a pas d'immat (vélos) dans l'onglet "Rapport 1" on ne fait pas de recherche car c'est un cas particulier.

Merci pour votre aide et bonne journée à tous

Bonjour,

Alors je viens de faire un code qui est fonctionnel, le/les problèmes :

- Certaine immatriculation ne sont pas trouvé car 2 écriture différentes (Ex: 1111 AA 11 | 1111AA11).

- Le fichier comporte énormément de ligne donc le programme met un peu de temps à ce réaliser.

Je cherche une solution pour tes immatriculations.

super merci pour ton travail

Salut Danval,

premier jet...
La mise à jour se fait directement à l'ouverture.

Private Sub Workbook_Open()
'
Dim sWkT As Worksheet, sWk As Worksheet
Dim tRAP, tGBM, tSYB, tCCAS, tARCH
'
Application.ScreenUpdating = False
'
Set sWkT = Worksheets("Rapport 1")
tRAP = sWkT.Range("I3:W" & sWkT.Range("I" & Rows.Count).End(xlUp).Row).Value
tGBM = Worksheets("GBM").Range("F2:O" & Worksheets("GBM").Range("F" & Rows.Count).End(xlUp).Row).Value
tSYB = Worksheets("SYBERT").Range("F2:O" & Worksheets("SYBERT").Range("F" & Rows.Count).End(xlUp).Row).Value
tCCAS = Worksheets("CCAS").Range("F2:O" & Worksheets("CCAS").Range("F" & Rows.Count).End(xlUp).Row).Value
tARCH = Worksheets("+ARCHEO").Range("F2:O" & Worksheets("+ARCHEO").Range("F" & Rows.Count).End(xlUp).Row).Value
'
On Error Resume Next
For x = 1 To UBound(tRAP, 1)
    If tRAP(x, 1) <> "" Then
        iOK = 0
        For y = 1 To 4
            For Z = 1 To UBound(Choose(y, tGBM, tSYB, tCCAS, tARCH), 1)
                If Choose(y, tGBM(Z, 1), tSYB(Z, 1), tCCAS(Z, 1), tARCH(Z, 1)) = tRAP(x, 1) Then
                    iOK = 1
                    For w = 11 To 15
                        If Choose(y, tGBM(Z, w - 5), tSYB(Z, w - 5), tCCAS(Z, w - 5), tARCH(Z, w - 5)) <> tRAP(x, w) Then _
                            Set sWk = Worksheets(Choose(y, "GBM", "SYBERT", "CCAS", "+ARCHEO")): _
                            sWk.Range("K" & Z + 1).Resize(1, 5).Copy Destination:=sWkT.Range("S" & x + 2).Resize(1, 5): _
                            iOK = 2: _
                            Exit For
                    Next
                    If iOK > 0 Then Exit For
                End If
            Next
            If iOK = 2 Then Exit For
        Next
    End If
Next
On Error GoTo 0
'
Application.ScreenUpdating = True
'
End Sub
6danval.xlsm (303.11 Ko)


A+

Bonjour,

merci pour la macro mais il faut copier la ligne complète dans l'onglet "Rapport 1" en fait ne pas s'occuper des entête de colonnes.

et j'ai l'impression qu'il copie toujours la même chose ou c'est le hasard.

je confirme il copie toujours la même chose

Forcément, c'est une mise à jour! Entre deux essais, maintenant, j'imagine que rien ne change dans les données !!
Copier à partir de la colonne [S], dis-tu, donc dans les autres feuilles, les colonnes [K:O], non ?

Ou alors, il faudra ré-expliquer plus clairement ton problème !

A+

alors il faut copier la ligne trouvée en entier dans l'onglet "Rapport 1" mais en commençant par la case "S"

Ah, ok, j'ai fait l'inverse en fait : je copiais VERS 'Rapport 1' !
Je rectifie et j'envoie...

Je te fournit simplement le code, mais vérifie tes immats, elles n'ont pas le même format donc le programme ne trouve pas tout.

Dim ThisSh As Worksheet
Dim ShDonnées As Worksheet

Set ThisSh = Sheets("Rapport 1")

For i = 3 To ThisSh.Range("B65535").End(xlUp).Row
    If ThisSh.Cells(i, "I") <> "" Then
        For Each ShDonnées In ThisWorkbook.Sheets
            If ShDonnées.Name <> ThisSh.Name Then
                For j = 2 To ShDonnées.Range("A65535").End(xlUp).Row
                    If ThisSh.Cells(i, "I") = ShDonnées.Cells(j, "F") Then
                        ShDonnées.Range("K" & j & ":O" & j).Copy
                        ThisSh.Range("S" & i & ":W" & i).PasteSpecial
                    End If
                Next
            End If
        Next
    End If
Next

@ tester... perso, j'y vois plus très clair...

3danval-v2.xlsm (289.55 Ko)


A+

ok j'ai fait quelques ajustement et elle tourne à merveille je vais voir pour uniformiser les immat avec une macro et là je serais au top.

un grand merci pour ton aide. je met le code dessous au cas ou cela peut servir.

Sub maj()
'
Dim ThisSh As Worksheet
Dim ShDonnées As Worksheet

Set ThisSh = Sheets("Rapport 1")

For i = 3 To ThisSh.Range("B65535").End(xlUp).Row
    If ThisSh.Cells(i, "I") <> "" Then
        For Each ShDonnées In ThisWorkbook.Sheets
            If ShDonnées.Name <> ThisSh.Name Then
                For j = 2 To ShDonnées.Range("A65535").End(xlUp).Row
                    If ThisSh.Cells(i, "I") = ShDonnées.Cells(j, "F") Then
                        ShDonnées.Range("A" & j & ":O" & j).Copy
                        ThisSh.Range("S" & i & ":AG" & i).PasteSpecial
                    End If
                Next
            End If
        Next
    End If
Next
End Sub
Rechercher des sujets similaires à "travail tableaux"