Ajout de conditions sur deux macros qui ont la même fonction

NkRedoxx -
ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention - 9 juin 2016 à 13:42

Bonjour, je dispose de deux macros quasiment identique et qui font exactement la même chose ! J'aimerais poser une condition pour les deux macros. J'aimerais en fait que la macro1 traite que les num de switch EAR 268,269 et 270 et que la macro2 fasse les num de switch EAR 266 et 267. Ma macro 1 renvoie un résultat en colonne B de SOMMAIRE et ma macro 2 en colonne C. Les numéros des switchs se trouve en colonne E en BAIE AT10 et en colonne A de DATA SWITCH en fonction de ces deux colonnes . Je vous laisse ci-joint tous les documents merci à vous !

Macro 1 : http://www.cjoint.com/c/FFihHzfJ8XC
Macro 2 : http://www.cjoint.com/c/FFihIdqO8VC
Fichier Excel : http://www.cjoint.com/c/FFihINhFNnC

Afficher la suite

A voir également:

Ajout de conditions sur deux macros qui ont la même fonction
Fonction si et - Guide
Comment faire deux colonnes sur word - Guide
Nombre de jours entre deux dates excel - Guide
Deux compte whatsapp sur le même téléphone samsung - Guide
Deux ecran pc - Guide

4 réponses

Réponse 1 / 4

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338

Bonjour
Si j'ai bien compris

Option Explicit
    Const F1 = "BAIE AT10"
    Const lidebF1 = 2
    Const coF1 = "F"
    Const F2 = "DATA SWITCH"
    Const lidebF2 = 2
    Const coF2 = "B"
    Const FR = "SOMMAIRE"
    Const lidebFR = 2
    Const coFRB = "B"
    Const coFRC = "C"
    Const nonOK = "NO BRASS NON AFFECT DON'T CONNECT "
    
Public Sub Ports_Dispo()
    Dim liF As Long, lifinF As Long
    Dim obj As Object
    Dim dico As Object, cle As String, cles, valeurs, nbcles As Long, nucle As Long
    Set dico = CreateObject("scripting.dictionary")
    With Sheets(F1)
        lifinF = .Range(coF1 & Rows.Count).End(xlUp).Row
        For liF = lidebF1 To lifinF
            cle = .Range(coF1 & liF).Value
            If InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR268" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR269" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR270" Then
                If Not dico.exists(cle) Then dico.Add cle, 1
            End If
        Next liF
    End With
    With Sheets(F2)
        lifinF = .Range(coF2 & Rows.Count).End(xlUp).Row
        For liF = lidebF2 To lifinF
            cle = .Range(coF2 & liF).Value
            If InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR268" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR269" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR270" Then
                If dico.exists(cle) Then
                    dico.Remove (cle)
                Else
                    dico.Add cle, 1
                End If
            End If
        Next liF
    End With
    cles = dico.keys
    valeurs = dico.items
    nbcles = dico.Count
    Sheets(FR).Range(coFRB & lidebFR).Resize(nbcles - 1, 1) = Application.Transpose(cles)
End Sub

Public Sub Ports_Dispo266267()
    Dim derlig As Long
    Dim liF As Long, lifinF As Long
    Dim obj As Object
    Dim dico As Object, cle As String, cles, valeurs, nbcles As Long, nucle As Long
    Set dico = CreateObject("scripting.dictionary")
    With Sheets(F1)
        lifinF = .Range(coF1 & Rows.Count).End(xlUp).Row
        For liF = lidebF1 To lifinF
            cle = .Range(coF1 & liF).Value
            If InStr(1, nonOK, cle) = 0 And .Cells(liF, "A") = "EAR266" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "A") = "EAR267" Then
                If Not dico.exists(cle) Then dico.Add cle, 1
            End If
        Next liF
    End With
    With Sheets(F2)
        lifinF = .Range(coF2 & Rows.Count).End(xlUp).Row
        For liF = lidebF2 To lifinF
            cle = .Range(coF2 & liF).Value
            If InStr(1, cle, nonOK) = 0 And .Cells(liF, "A") = "EAR266" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "A") = "EAR267" Then
                If dico.exists(cle) Then
                    dico.Remove (cle)
                Else
                    dico.Add cle, 1
                End If
            End If
        Next liF
    End With
    cles = dico.keys
    valeurs = dico.items
    nbcles = dico.Count
    With Sheets(FR)
        .Range(coFRC & lidebFR).Resize(nbcles - 1, 1) = Application.Transpose(cles)
        Application.DisplayAlerts = False
        With Worksheets("SOMMAIRE")
            derlig = .Range("C" & Rows.Count).End(xlUp).Row
            Columns("C:C").Select
            .Range("$C$1:$C$" & derlig).RemoveDuplicates Columns:=1, Header:=xlYes
        End With
        Application.DisplayAlerts = True
    End With
End Sub

A tester
Cdlt