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

momo · 8 Février 2019

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 · 8 Février 2019

Bonjour

A tester

momo · 8 Février 2019

M12 à dit:
Bonjour

A tester

C’est excellent
Merci beaucoup

job75 · 9 Février 2019

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+

momo · 9 Février 2019

job75 à dit:

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é

momo · 9 Février 2019

job75 à dit:
.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 · 9 Février 2019

momo à dit:
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 · 9 Février 2019

momo à dit:
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"

momo à dit:
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 · 9 Février 2019

job75 à dit:
If col Then .Columns(3).Resize(, col).NumberFormat = "#,##0.00"

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

momo · 9 Février 2019

job75 à dit:
l faudrait joindre un fichier montrant le résultat souhaité.

Voici le fichier

job75 · 9 Février 2019

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

momo · 9 Février 2019

job75 à dit:
Dans ce fichier (3) on utilise le Dictionary :

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

job75 · 9 Février 2019

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 · 9 Février 2019

job75 à dit:
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

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

momo

XLDnaute Occasionnel

Pièces jointes

M12

XLDnaute Accro

Pièces jointes

momo

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

momo

XLDnaute Occasionnel

momo

XLDnaute Occasionnel

momo

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

momo

XLDnaute Occasionnel

momo

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

momo

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

momo

XLDnaute Occasionnel

Discussions similaires

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

XLDnaute Occasionnel

Pièces jointes

XLDnaute Accro

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency