XL 2013 Recherche Colonne contenant Erreur(#N/A; #Valeur etc)

[momo]

Bonjour à tous,

Je voudrais obtenir un tableau récapitulatif qui se présente sous ce format (voir fichier joint)

Pour cela, je voudrais un petit programme qui me permettrait dès que je clique sur un bouton, qu'il aille rechercher dans les trois bases (Source A , B et C), toutes les données dont la colonne Infos renvoie une erreur de type #N/A; #Valeur etc..

Merci en avance pour le coup de main

 

[M12]

Bonjour

A tester

 

[momo]

Bonjour

A tester

C’est excellent
Merci beaucoup

 

[job75]

Bonjour momo, M12, le forum,

Cette macro est très rapide car elle utilise des tableaux VBA :

Private Sub Worksheet_Activate()
Dim resu(), w As Worksheet, trouve As Boolean, tablo, i&, col%, n&
ReDim resu(1 To Rows.Count, 1 To 1 + Worksheets.Count)
'---remplissage du tableau des résultats---
resu(1, 1) = "N°": resu(1, 2) = "Intitulé": n = 1
For Each w In Worksheets
    If w.Name <> Me.Name Then
        trouve = False
        tablo = w.UsedRange.Resize(, 4) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            If IsError(tablo(i, 1)) Then
                If Not trouve Then trouve = True: col = col + 1: resu(1, col + 2) = w.Name
                n = n + 1
                resu(n, 1) = tablo(i, 2)
                resu(n, 2) = tablo(i, 3)
                resu(n, col + 2) = tablo(i, 4)
            End If
        Next
    End If
Next
'---restitution---
Application.ScreenUpdating = False
Cells.Delete 'RAZ
With [A3].Resize(n, col + 2) 'cellule à adapter
    .Value = resu
    .Borders.Weight = xlThin 'bordures
    .Rows(1).Interior.ColorIndex = 5 'bleu
    .Rows(1).Font.ColorIndex = 2 'blanc
    .Rows(1).Font.Bold = True 'gras
    .Columns.AutoFit 'ajustement largeurs
End With
End Sub

Elle se déclenche quand on active la feuille "Synthèse".

A+

 

[momo]

Bonjour momo, M12, le forum,

Cette macro est très rapide car elle utilise des tableaux VBA :

Private Sub Worksheet_Activate()
Dim resu(), w As Worksheet, trouve As Boolean, tablo, i&, col%, n&
ReDim resu(1 To Rows.Count, 1 To 1 + Worksheets.Count)
'---remplissage du tableau des résultats---
resu(1, 1) = "N°": resu(1, 2) = "Intitulé": n = 1
For Each w In Worksheets
    If w.Name <> Me.Name Then
        trouve = False
        tablo = w.UsedRange.Resize(, 4) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            If IsError(tablo(i, 1)) Then
                If Not trouve Then trouve = True: col = col + 1: resu(1, col + 2) = w.Name
                n = n + 1
                resu(n, 1) = tablo(i, 2)
                resu(n, 2) = tablo(i, 3)
                resu(n, col + 2) = tablo(i, 4)
            End If
        Next
    End If
Next
'---restitution---
Application.ScreenUpdating = False
Cells.Delete 'RAZ
With [A3].Resize(n, col + 2) 'cellule à adapter
    .Value = resu
    .Borders.Weight = xlThin 'bordures
    .Rows(1).Interior.ColorIndex = 5 'bleu
    .Rows(1).Font.ColorIndex = 2 'blanc
    .Rows(1).Font.Bold = True 'gras
    .Columns.AutoFit 'ajustement largeurs
End With
End Sub

Elle se déclenche quand on active la feuille "Synthèse".

A+[/QUOTEMerci Job pour la contribution .

C'st exactement le résultat escompté

 

[momo]

.Columns.AutoFit 'ajustement largeurs

Vous avez une petite idée de comment faire pour que les chiffres s'affichent avec le séparateur de milliers?

Est ce que c'est possible que , a numéro identique (Numero en colonne A sur la feuille synthèse), les valeurs de chaque feuille source s'affiche sur la même ligne?

 

[momo]

Vous avez une petite idée de comment faire pour que les chiffres s'affichent avec le séparateur de milliers?

J'ai pu le faire tout seul

 

[job75]

Vous avez une petite idée de comment faire pour que les chiffres s'affichent avec le séparateur de milliers?

Dans ce fichier (2) j'ai ajouté la ligne :

    If col Then .Columns(3).Resize(, col).NumberFormat = "#,##0.00"

Est ce que c'est possible que , a numéro identique (Numero en colonne A sur la feuille synthèse), les valeurs de chaque feuille source s'affiche sur la même ligne?

Il faudrait joindre un fichier montrant le résultat souhaité.

 

[momo]

If col Then .Columns(3).Resize(, col).NumberFormat = "#,##0.00"

Encore mieux... merci bcp .. Mais la PJ n'est pas disponible

 

[momo]

l faudrait joindre un fichier montrant le résultat souhaité.

Voici le fichier

 

[job75]

Dans ce fichier (3) on utilise le Dictionary :

Private Sub Worksheet_Activate()
Dim resu(), d As Object, w As Worksheet, trouve As Boolean, tablo, i&, col%, x$, n&
ReDim resu(1 To Rows.Count, 1 To 1 + Worksheets.Count)
'---remplissage du tableau des résultats---
resu(1, 1) = "N°": resu(1, 2) = "Intitulé": n = 1
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each w In Worksheets
    If w.Name <> Me.Name Then
        trouve = False
        tablo = w.UsedRange.Columns(1).Resize(, 4) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            If IsError(tablo(i, 1)) Then
                If Not trouve Then trouve = True: col = col + 1: resu(1, col + 2) = w.Name
                x = tablo(i, 2) & tablo(i, 3)
                If Not d.exists(x) Then
                    n = n + 1
                    d(x) = n 'mémorise le numéro de ligne
                    resu(n, 1) = tablo(i, 2)
                    resu(n, 2) = tablo(i, 3)
                End If
                If IsNumeric(tablo(i, 4)) Then resu(d(x), col + 2) = resu(d(x), col + 2) + CDbl(tablo(i, 4)) 'somme
            End If
        Next
    End If
Next
'---restitution---
Application.ScreenUpdating = False
Cells.Delete 'RAZ
With [A3].Resize(n, col + 2) 'cellule à adapter
    .Value = resu
    If col Then .Columns(3).Resize(, col).NumberFormat = "#,##0.00"
    .Borders.Weight = xlThin 'bordures
    .Rows(1).Interior.ColorIndex = 5 'bleu
    .Rows(1).Font.ColorIndex = 2 'blanc
    .Rows(1).Font.Bold = True 'gras
    .Columns.AutoFit 'ajustement largeurs
End With
End Sub

 

[momo]

Dans ce fichier (3) on utilise le Dictionary :

Vous êtes trop fort!!!
Merci c'est impecc

 

[job75]

Je viens de modifier la macro précédente pour faire la somme des montants dont N° Intitulé et feuille sont identiques.

Pour tester j'ai copié les 3 tableaux sources sur 10 000 lignes, la macro s'exécute chez moi en 0,28 seconde.

 

[momo]

Je viens de modifier la macro précédente pour faire la somme des montants dont N° Intitulé et feuille sont identiques.

Pour tester j'ai copié les 3 tableaux sources sur 10 000 lignes, la macro s'exécute chez moi en 0,28 seconde.

Waooooo c'est awesome! en 0,28 Secondes , ca va vachement m'aider ca!

Merci encore et encore