Microsoft 365 Incompatibilité de type - Array

guiyom

XLDnaute Junior
Bonjour,

J'aurais besoin de votre aide car je rencontre une "incompatibilité de type". Je n'arrive pas à trouver la syntaxe correcte pour pouvoir sélectionner deux critères dans un même filtre.

Call TraitementGenerique(cheminExtraction, "ANGERS", "T9946094bf5ae4b42ba05aefc363cecf7", "<>", Array("TYU", "OUP"), "=KTM", "<>", Array(1, "7/28/2023"), "<>", 5)

Call TraitementGenerique(cheminExtraction, "ANGERS", "T9946094bf5ae4b42ba05aefc363cecf7", "<>", "=VERS", "=SOR", "<>", Array(1, "7/28/2023"), Array("=1", "=2", "=3", "=4", "=5", "=6", "=7", "=8", "=9"), 6)

Call TraitementGenerique(cheminExtraction, "ANGERS", "T9946094bf5ae4b42ba05aefc363cecf7", "<>", "=AGT", Array("CDE", "QWS"), "cdpoch", Array(1, "7/28/2023"), "<>", 7)


Voici le code complet si cela peut aider à la compréhension.

La macro ouvre un classeur positionné dans un répertoire spécifique, applique des filtres, fait l'addition des valeurs après filtre et les colle dans un autre classeur positionné dans un autre répertoire spécifique. Le problème est que je n'arrive pas à sélectionner deux critères en même temps sur un même filtre.

Merci d'avance.


VB:
Sub TraitementDonnees()
    ' Récupére les chemins des fichiers depuis la feuille1
    Dim cheminExtraction As String
    Dim cheminRecyclage As String
    cheminExtraction = Sheets("Feuil1").Range("A1").Value
    cheminRecyclage = Sheets("Feuil1").Range("A2").Value

    ' Appele la fonction de traitement pour chaque cas
    Call TraitementGenerique(cheminExtraction, "ANGERS", "T9946094bf5ae4b42ba05aefc363cecf7", "STOCK", "<>", "ORD", "<>", Array(1, "7/28/2023"), "<>", 0)
    Call TraitementGenerique(cheminExtraction, "ANGERS", "T9946094bf5ae4b42ba05aefc363cecf7", "<>", "AGT", "AGT", "<>", Array(1, "7/28/2023"), "<>", 4)
    Call TraitementGenerique(cheminExtraction, "ANGERS", "T9946094bf5ae4b42ba05aefc363cecf7", "<>", Array("TYU", "OUP"), "=KTM", "<>", Array(1, "7/28/2023"), "<>", 5)
    Call TraitementGenerique(cheminExtraction, "ANGERS", "T9946094bf5ae4b42ba05aefc363cecf7", "<>", "=VERS", "=SOR", "<>", Array(1, "7/28/2023"), Array("=1", "=2", "=3", "=4", "=5", "=6", "=7", "=8", "=9"), 6)
    Call TraitementGenerique(cheminExtraction, "ANGERS", "T9946094bf5ae4b42ba05aefc363cecf7", "<>", "=AGT", Array("CDE", "QWS"), "cdpoch", Array(1, "7/28/2023"), "<>", 7)
 
End Sub



Sub TraitementGenerique(chemin As String, feuille As String, nomTable As String, critere1 As String, critere2 As String, critere3 As String, critere4 As String, critere5 As Variant, critere6 As String, ByVal offset As Integer)
    ' Déclaration des variables
    Dim wsExtraction As Worksheet
    Dim wbExtraction As Workbook
    Dim tblExtraction As ListObject
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim col As Range
    Dim total As Double
    Dim cheminExtraction As String
    Dim cheminRecyclage As String
    cheminExtraction = Sheets("Feuil1").Range("A1").Value
    cheminRecyclage = Sheets("Feuil1").Range("A2").Value
 
    ' Ouvrir le fichier Extraction
    Set wbExtraction = Workbooks.Open(chemin)
    ' Référencer la feuille "ANGERS"
    Set wsExtraction = wbExtraction.Sheets(feuille)

    ' Référence la table
    Set tblExtraction = wsExtraction.ListObjects(nomTable)

    ' Applique les filtres à l'aide de ListObjects
    With tblExtraction
        .AutoFilter.ShowAllData ' Supprime les filtres existants
        .Range.AutoFilter Field:=1, criteria1:=critere1
        .Range.AutoFilter Field:=2, criteria1:=critere2
        .Range.AutoFilter Field:=5, criteria1:=critere3
        .Range.AutoFilter Field:=7, criteria1:=critere4
        .Range.AutoFilter Field:=8, Operator:=xlFilterValues, criteria2:=critere5
        .Range.AutoFilter Field:=6, criteria1:=critere6
    End With

    ' Défini la feuille de travail active
    Set ws = wbExtraction.Sheets(feuille)

    ' Parcourir les colonnes spécifiées
    For Each col In ws.Range("A1:Z1").Cells
        If col.Value = "500E" Or col.Value = "200E" Or col.Value = "100E" Or col.Value = "50E" Or col.Value = "20E" Or col.Value = "10E" Or col.Value = "5E" Then
            ' Réinitialiser le total pour chaque colonne
            total = 0

            ' Parcourir les lignes de la colonne (de la ligne 2 à la dernière ligne)
            For i = 2 To ws.Cells(ws.Rows.Count, col.Column).End(xlUp).row
                ' Ajoute la valeur uniquement si la ligne est visible
                If ws.Rows(i).Hidden = False Then
                    total = total + ws.Cells(i, col.Column).Value
                End If
            Next i

            ' Affiche le total dans la dernière ligne + 1 de la colonne
            ws.Cells(ws.Rows.Count, col.Column).End(xlUp).offset(1, 0).Value = total
        End If
    Next col

    ' Copie les valeurs non vides de la dernière ligne + 1
    lastRow = wsExtraction.Cells(wsExtraction.Rows.Count, "A").End(xlUp).row + 1
    ' Trouve la dernière colonne utilisée dans la ligne
    lastColumn = wsExtraction.Cells(lastRow, wsExtraction.Columns.Count).End(xlToLeft).Column
    ' Défini la plage de la dernière ligne
    Set rangeToCopy = wsExtraction.Range(wsExtraction.Cells(lastRow, 1), wsExtraction.Cells(lastRow, lastColumn))

    ' Filtre les valeurs non vides
    Set nonEmptyCells = Nothing
    For Each cell In rangeToCopy
        If cell.Value <> "" Then
            If nonEmptyCells Is Nothing Then
                Set nonEmptyCells = cell
            Else
                Set nonEmptyCells = Union(nonEmptyCells, cell)
            End If
        End If
    Next cell

    ' Copie les valeurs non vides
    If Not nonEmptyCells Is Nothing Then
        nonEmptyCells.Copy
    End If

    ' Ouvre le fichier wsRecyclage
    Set wsRecyclage = Workbooks.Open(cheminRecyclage).Sheets(feuille)

    ' Cherche le mot "Juillet" dans la feuille "ANGERS"
    Dim celluleJuillet As Range
    Set celluleJuillet = wsRecyclage.Cells.Find("Juillet")

    ' Vérifie si le mot "Juillet" a été trouvé
    If Not celluleJuillet Is Nothing Then
        ' Colle deux lignes en dessous de la cellule contenant "Juillet"
        wsRecyclage.Cells(celluleJuillet.row + 2, celluleJuillet.Column + offset).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    End If

 
 
    ' Ferme les fichiers sans sauvegarder les changements
    wbExtraction.Close SaveChanges:=False
    wsRecyclage.Parent.Close SaveChanges:=True
End Sub
 
Dernière édition:

Statistiques des forums

Discussions
312 803
Messages
2 092 250
Membres
105 316
dernier inscrit
cyrille225