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

momo

XLDnaute Occasionnel
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
 

Pièces jointes

  • Recherche erreur.xlsx
    11.6 KB · Affichages: 18

job75

XLDnaute Barbatruc
Bonjour momo, M12, le forum,

Cette macro est très rapide car elle utilise des tableaux VBA :
Code:
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+
 

Pièces jointes

  • Recherche erreur(1).xlsm
    23 KB · Affichages: 7

momo

XLDnaute Occasionnel
Bonjour momo, M12, le forum,

Cette macro est très rapide car elle utilise des tableaux VBA :
Code:
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é
 

job75

XLDnaute Barbatruc
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 :
Code:
    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é.
 

Pièces jointes

  • Recherche erreur(2).xlsm
    26.2 KB · Affichages: 4

job75

XLDnaute Barbatruc
Dans ce fichier (3) on utilise le Dictionary :
Code:
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
 

Pièces jointes

  • Recherche erreur(3).xlsm
    28.3 KB · Affichages: 7
Dernière édition:

job75

XLDnaute Barbatruc
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.
 

Discussions similaires