Traitement des cellules non trouvée par la méthode find()

[arthurho]

Bonjour,

J'ai réalisé une macro qui cherche l'entité "FDM" dans la colonne F de la feuille 1.
Certaines de ces cellules ne possède pas cette entité. Je voudrais effectuer un traitement sur les lignes de ces cellules de la même manière que celles que find() m'a permis de séléctionner.

Le traitement est le suivant :

1) Les lignes des cellules séléctionnées par find sont copiées dans un onglet portant le même nom que ce que retourne la méthode find()
=> VALIDE
2)Pour le cas des autres cellules, copie des lignes non trouvées par find dans un autre onglet nommé "Anomalies"
=> NON VALIDE

J'ai réalisé la macro excel suivante :

Private Function FormatTestCase()

Application.ScreenUpdating = False

Dim FDM_tmp As String
Dim SourceRange As Range
Dim destrange As Range
Dim j As Integer
Dim LDst As Long, FDst As Worksheet

entité = "FDM"

Worksheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = "Anomalies"

endactivesheet = Sheets(1).[F65536].End(xlUp).Row

Set c = Sheets(1).Range("F1:" & "F" & endactivesheet).Find(entité, LookIn:=xlValues, lookat:=xlPart)
    
        'Initialisation du compteur de lignes de longlet source '
        j = 2
        
    
        If Not c Is Nothing Then
            firstaddress = c.Address
            'Boucle sur l'ensemble de la colonne F à partir de la deuxième ligne'
            Do
                Sheets(1).Cells(j, 13) = "marqué"
                FDM_tmp = c.Value

                'Si l'onglet nexiste pas'
                If Onglet_exist(FDM_tmp) = False Then
                               
                    Worksheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
                    ActiveSheet.Name = FDM_tmp
                        
                    Set destrange = Sheets(FDM_tmp).Range("A" & 2 & ":L" & 2)
            
                'Si longlet existe'
                Else
                    'Tweak pour éviter de parcourir les onglets pour compter le nombre de ligne'
                    Set FDst = Worksheets(FDM_tmp)
                    ' Ligne qui suit le dernier F non vide'
                    LDst = FDst.[F65536].End(xlUp).Row + 1
                    
                    Set destrange = Sheets(FDM_tmp).Range("A" & LDst & ":L" & LDst)
                End If
                    
                'Processus de copie de chaque ligne'
                Set SourceRange = Sheets(1).Range("A" & j & ":L" & j)
        
                SourceRange.Copy destrange
                      
                Sheets(1).Select

                j = j + 1

              Set c = Sheets(1).Columns(6).FindNext(c)
          Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
End Function


'Tester l'existence d'un onglet'
Private Function Onglet_exist(Nom As String) As Boolean
    Dim sh As Worksheet
    Onglet_exist = False
    For Each sh In Sheets
    
        If sh.Name = Nom Then
            Onglet_exist = True
            Exit For
        End If
    Next
End Function

Comment faire pour copier les lignes des cellules que find a "manqué", dans l'onglet Anomalies ?

merci de votre aide,

Arthur HO.

 

[Odesta]

Re : Traitement des cellules non trouvée par la méthode find()

Bonjour

Comment faire pour copier les lignes des cellules que find a "manqué"

Par définition, find ne va vous sélectionner que les valeurs qu'il va trouver.

L'une des solutions serait plutôt de parcourir toutes les cellules de la colonne F (à l'aide d'un while / wend ou d'un for / next) puis d'aiguillé en fonction du contenu sur tel ou tel code ou macro.

Enfin c'est juste une idée

Cdt

Olivier

 

[JNP]

Re : Traitement des cellules non trouvée par la méthode find()

Bonjour le fil ,
Avec un fichier test qui corresponde à quelque chose, tu aurais certainement plus de réponses ...
Pas sûr d'avoir tout compris du coup ...
A tester

Sub test()
Dim Tablo(), I As Integer, Feuille As Worksheet, MaFeuille As String, Temp
Dim DerLigne As Integer
Worksheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = "Anomalies"
For Each Feuille In ThisWorkbook.Worksheets
    ReDim Preserve Tablo(I)
    Tablo(I) = Feuille.Name
    I = I + 1
Next Feuille
With Sheets(1)
For I = 2 To .[F65536].End(xlUp).Row
If .Range("F" & I) Like "*FDM*" Then
.Cells(I, 13) = "marqué"
MaFeuille = .Range("F" & I)
On Error GoTo Erreur
Temp = Application.WorksheetFunction.Match(MaFeuille, Tablo, 0)
On Error GoTo 0
Else
MaFeuille = "anomalies"
End If
If Sheets(MaFeuille).Range("F1") = "" Then
DerLigne = 1
Else
DerLigne = Sheets(MaFeuille).[F65536].End(xlUp).Row + 1
End If
.Rows(I).Copy Sheets(MaFeuille).Rows(DerLigne)
Next I
End With
Exit Sub
Erreur:
Worksheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = MaFeuille
ReDim Preserve Tablo(UBound(Tablo) + 1)
Tablo(UBound(Tablo)) = MaFeuille
Resume
End Sub

Bonne suite