Problème de comparaison entre deux cellules

Résolu
Geoffroy45 Messages postés 12 Statut Membre -  
Geoffroy45 Messages postés 12 Statut Membre -
Bonjour,

Je souhaite comparer deux valeurs d'une page avec une liste de valeur concaténée dans une seule cellule sur une autre pages du même classeur Excel.
Voici un Extrait de mon code :

While ActiveCell.Value <> ""
CelluleA = Cells(Numligne, Numcolonne).Value
Cells(Numligne, Numcol).Select
CelluleB = Cells(Numligne, Numcol).Value
Windows("Retardcarnet2007.htm").Activate
'verification si retard annoncé
semaine = semaine - 1
Numcolonneseg = Numcolonneseg + 1
Windows("Retardcarnet2007.htm").Activate
Worksheets(semaine).Activate
Cells(Numligneseg, Numcolonneseg).Select
If Cells(Numligneseg, Numcolonneseg).Value = CelluleA & " " & CelluleB Then
'Concatenation de la cellule cible avec les données sources en rouge
With Cells(Numligne, Numcolonne).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
With Cells(Numligne, Numcol).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
semaine = semaine + 1
Numcolonneseg = Numcolonneseg - 1
Worksheets(semaine).Activate
Cells(Numligneseg, Numcolonneseg).Formula = Cells(Numligneseg, Numcolonneseg).Formula & Chr(10) & CelluleA & " " & CelluleB
Windows("Retards carnet 070615.xls").Activate
Numligne = (Numligne + 1)
Cells(Numligne, Numcolonne).Select
Else
'Concatenation de la cellule cible avec les données sources
semaine = semaine + 1
Numcolonneseg = Numcolonneseg - 1
Worksheets(semaine).Activate
Cells(Numligneseg, Numcolonneseg).Formula = Cells(Numligneseg, Numcolonneseg).Formula & Chr(10) & CelluleA & " " & CelluleB
Windows("Retards carnet 070615.xls").Activate
Numligne = (Numligne + 1)
Cells(Numligne, Numcolonne).Select
End If
Wend

Si quelqu'un connait le bon code pour effectuer cette comparaison, je lui serai reconnaissant.
Configuration: Windows XP
Internet Explorer 6.0
Suite Office 2003

4 réponses

  1. Utilisateur anonyme
     
    Bonjour,

    Malheureusement, je ne puis tester votre code ... n'ayant pas les objets cités ...

    voici par contre un nettoyage à ma façon de votre code ... cela pourrait vous donner des idées ... 

    Option Explicit
'
Public Const Classeur_Maitre = "Retards carnet 070615.xls"
Public Const PageWeb_Maitre = "Retardcarnet2007.htm"
'


Sub Test_Cellules()

    Dim CelluleA As String, CelluleB As String
    Dim NumLigne As Integer, NumColonne As Integer, NumCol As Integer
    Dim NumLigneSeg As Integer, NumColonneSeg As Integer
    Dim Semaine As Variant

    While ActiveCell.Value <> ""
        CelluleA = Cells(NumLigne, NumColonne).Value
        Cells(NumLigne, NumCol).Select
        CelluleB = Cells(NumLigne, NumCol).Value
        Windows(PageWeb_Maitre).Activate
        ' Vérification si retard annoncé
        Semaine = Semaine - 1
        NumColonneSeg = NumColonneSeg + 1
        Worksheets(Semaine).Activate
        Cells(NumLigneSeg, NumColonneSeg).Select
        If Cells(NumLigneSeg, NumColonneSeg).Value = CelluleA & " " & CelluleB Then
            'Concatenation de la cellule cible avec les données sources en rouge
            Cells(NumLigne, NumColonne).Font.ColorIndex = 3
            Cells(NumLigne, NumCol).Font.ColorIndex = 3
            Semaine = Semaine + 1
            NumColonneSeg = NumColonneSeg - 1
            Worksheets(Semaine).Activate
            Cells(NumLigneSeg, NumColonneSeg).Formula = _
                     Cells(NumLigneSeg, NumColonneSeg).Formula & _
                                   Chr(10) & CelluleA & " " & CelluleB
            Windows(Classeur_Maitre).Activate
            NumLigne = (NumLigne + 1)
            Cells(NumLigne, NumColonne).Select
        Else
            'Concatenation de la cellule cible avec les données sources
            Semaine = Semaine + 1
            NumColonneSeg = NumColonneSeg - 1
            Worksheets(Semaine).Activate
            Cells(NumLigneSeg, NumColonneSeg).Formula = _
                     Cells(NumLigneSeg, NumColonneSeg).Formula & _
                                     Chr(10) & CelluleA & " " & CelluleB
            Windows(Classeur_Maitre).Activate
            NumLigne = (NumLigne + 1)
            Cells(NumLigne, NumColonne).Select
        End If
    Wend

End Sub
'

    Il y aurait lieu de mieux connaître la syntaxe de l'objet [ Semaine ], le mot objet désigne dans mon
    discour, un classeur, une variable, une main mise sur, une collection, etc ... (n'importe quoi ...)

    dans mon exemple, je l'ai typé [ Variant ], ne connaissant pas la structure même si celle-ci est
    utilisé pour nommer des feuilles. Est-ce une chaine de caractères ? Est-ce un nombre ? Est-ce une date ?

    Lupin
    0
  2. Geoffroy45 Messages postés 12 Statut Membre 1
     
    Voici mon code au complet, il s'agit d'un userform auquel est rattaché du code :

    Private Sub Annuler_Click()
    Unload export
    End Sub

    Private Sub Exporter_Click()
    Dim Numligne As Integer
    Dim Numcolonne As Integer
    Dim Numcol As Integer
    Dim counter As Integer
    Dim counter2 As Integer
    Dim Numligneseg As Integer
    Dim Numcolonneseg As Integer
    Dim CelluleA As String
    Dim CelluleB As String
    Dim seg As String
    Dim segment As String
    Dim semaine As String
    Dim feuilleExiste As Boolean
    counter = 0
    counter2 = 0
    Numligneseg = 5
    Numcolonneseg = 1
    Numcolonne = 3
    Numligne = 5
    Numcol = 4
    CelluleA = 0
    CelulleB = 0
    seg = 0
    semaine = 0
    segment = 0
    feuilleExiste = False
    Workbooks.Open Filename:="L:\Mes documents\Retardcarnet2007.htm"
    'Vérification de la présence de la feuille semaine
    Windows("Retards carnet 070615.xls").Activate
    Range("F1").Select
    semaine = Range("F1").Value
    Windows("Retardcarnet2007.htm").Activate
    For Each Feuille In Worksheets
    If (Feuille.Name = semaine) Then
    feuilleExiste = True
    End If
    Next Feuille
    If feuilleExiste = False Then
    'Création de la feuille semaine
    Sheets.Add
    Sheets("ORIGINAL").Select
    Cells.Select
    Selection.Copy
    Sheets("Feuil2").Select
    ActiveSheet.Paste
    Range("A1:E1").Select
    Sheets("Feuil2").Select
    Windows("Retards carnet 070615.xls").Activate
    Range("F1").Select
    semaine = Range("F1").Value
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = semaine
    Windows("Retardcarnet2007.htm").Activate
    Sheets("Feuil2").Select
    Sheets("Feuil2").Name = semaine
    Range("A1").FormulaR1C1 = "RETARD CARNET - Semaine" & semaine
    Else
    'activation de la bonne feuille
    Windows("Retards carnet 070615.xls").Activate
    Range("F1").Select
    semaine = Range("F1").Value
    Windows("Retardcarnet2007.htm").Activate
    Worksheets(semaine).Activate
    End If
    'comparaison du segment
    Windows("Retardcarnet2007.htm").Activate
    Cells(Numligneseg, Numcolonneseg).Select
    seg = Cells(Numligneseg, Numcolonneseg).Value
    Windows("Retards carnet 070615.xls").Activate
    Cells(Numligne, Numcolonneseg).Select
    segment = Cells(Numligne, Numcolonneseg).Value
    While segment <> seg
    Windows("Retardcarnet2007.htm").Activate
    Numligneseg = Numligneseg + 1
    Cells(Numligneseg, Numcolonneseg).Select
    seg = Cells(Numligneseg, Numcolonneseg).Value
    Wend
    Windows("Retards carnet 070615.xls").Activate
    Cells(Numligne, Numcolonne).Select
    Numcolonneseg = Numcolonneseg + 3
    'remplissage du retard anterieur
    While ActiveCell.Value <> ""
    CelluleA = Cells(Numligne, Numcolonne).Value
    Cells(Numligne, Numcol).Select
    CelluleB = Cells(Numligne, Numcol).Value
    Windows("Retardcarnet2007.htm").Activate
    'verification si retard annoncé
    semaine = semaine - 1
    Numcolonneseg = Numcolonneseg + 1
    Worksheets(semaine).Activate
    Cells(Numligneseg, Numcolonneseg).Select
    If Cells(Numligneseg, Numcolonneseg).Formula = CelluleA & " " & CelluleB Then
    'Concatenation de la cellule cible avec les données sources en rouge
    Cells(Numligne, Numcolonne).Font.ColorIndex = 3
    Cells(Numligne, Numcol).Font.ColorIndex = 3
    semaine = semaine + 1
    Numcolonneseg = Numcolonneseg - 1
    Worksheets(semaine).Activate
    Cells(Numligneseg, Numcolonneseg).Formula = Cells(Numligneseg, Numcolonneseg).Formula & Chr(10) & CelluleA & " " & CelluleB
    Windows("Retards carnet 070615.xls").Activate
    Numligne = (Numligne + 1)
    Cells(Numligne, Numcolonne).Select
    Else
    'Concatenation de la cellule cible avec les données sources
    semaine = semaine + 1
    Numcolonneseg = Numcolonneseg - 1
    Worksheets(semaine).Activate
    Cells(Numligneseg, Numcolonneseg).Formula = Cells(Numligneseg, Numcolonneseg).Formula & Chr(10) & CelluleA & " " & CelluleB
    Windows("Retards carnet 070615.xls").Activate
    Numligne = (Numligne + 1)
    Cells(Numligne, Numcolonne).Select
    End If
    Wend
    Windows("Retards carnet 070615.xls").Activate
    Numligne = 5
    Numcolonne = Numcolonne + 4
    Numcol = Numcol + 4
    Cells(Numligne, Numcolonne).Select
    'remplissage du retard de la semaine
    While ActiveCell.Value <> ""
    CelluleA = Cells(Numligne, Numcolonne).Value
    Cells(Numligne, Numcol).Select
    CelluleB = Cells(Numligne, Numcol).Value
    Windows("Retardcarnet2007.htm").Activate
    'verification si retard annoncé
    semaine = semaine - 1
    Numcolonneseg = Numcolonneseg + 1
    Windows("Retardcarnet2007.htm").Activate
    Worksheets(semaine).Activate
    Cells(Numligneseg, Numcolonneseg).Select
    If Cells(Numligneseg, Numcolonneseg).Formula = CelluleA & " " & CelluleB Then
    'Concatenation de la cellule cible avec les données sources en rouge
    Cells(Numligne, Numcolonne).Font.ColorIndex = 3
    Cells(Numligne, Numcol).Font.ColorIndex = 3
    semaine = semaine + 1
    Numcolonneseg = Numcolonneseg - 1
    Worksheets(semaine).Activate
    Cells(Numligneseg, Numcolonneseg).Formula = Cells(Numligneseg, Numcolonneseg).Formula & Chr(10) & CelluleA & " " & CelluleB
    Windows("Retards carnet 070615.xls").Activate
    Numligne = (Numligne + 1)
    Cells(Numligne, Numcolonne).Select
    Else
    'Concatenation de la cellule cible avec les données sources
    semaine = semaine + 1
    Numcolonneseg = Numcolonneseg - 1
    Worksheets(semaine).Activate
    Cells(Numligneseg, Numcolonneseg).Formula = Cells(Numligneseg, Numcolonneseg).Formula & Chr(10) & CelluleA & " " & CelluleB
    Windows("Retards carnet 070615.xls").Activate
    Numligne = (Numligne + 1)
    Cells(Numligne, Numcolonne).Select
    End If
    Wend
    Numligne = 5
    Numcolonne = Numcolonne + 4
    Numcol = Numcol + 4
    Cells(Numligne, Numcolonne).Select
    Numcolonneseg = Numcolonneseg + 1
    'remplissage du risque de retard
    While ActiveCell.Value <> ""
    CelluleA = Cells(Numligne, Numcolonne).Value
    Cells(Numligne, Numcol).Select
    CelluleB = Cells(Numligne, Numcol).Value
    Windows("Retardcarnet2007.htm").Activate
    Cells(Numligneseg, Numcolonneseg).Select
    'Concatenation de la cellule cible avec les données sources
    Cells(Numligneseg, Numcolonneseg).Formula = Cells(Numligneseg, Numcolonneseg).Formula & Chr(10) & CelluleA & " " & CelluleB
    Windows("Retards carnet 070615.xls").Activate
    Numligne = (Numligne + 1)
    Cells(Numligne, Numcolonne).Select
    Wend
    'Remplissage du nombre d'article en retard et
    Windows("Retards carnet 070615.xls").Activate
    semaine = semaine - 1
    Numcolonne = 2
    Numligne = 5
    Cells(Numligne, Numcolonne).Select
    counter = Cells(Numligne, Numcolonne).Value
    Windows("Retardcarnet2007.htm").Activate
    Cells(Numligneseg, Numcolonne).Formula = counter
    Sheets(semaine).Select
    counter2 = Cells(Numligneseg, Numcolonne).Value
    If counter < counter2 Then
    Windows("Retards carnet 070615.xls").Activate
    Range("F1").Select
    semaine = Range("F1").Value
    Windows("Retardcarnet2007.htm").Activate
    Worksheets(semaine).Activate
    Numcolonne = Numcolonne + 1
    Cells(Numligneseg, Numcolonne).Interior.Color = vbGreen
    Else
    If counter = counter2 Then
    Windows("Retards carnet 070615.xls").Activate
    Range("F1").Select
    semaine = Range("F1").Value
    Windows("Retardcarnet2007.htm").Activate
    Worksheets(semaine).Activate
    Numcolonne = Numcolonne + 1
    Cells(Numligneseg, Numcolonne).Interior.Color = QBColor(8)
    Else
    Windows("Retards carnet 070615.xls").Activate
    Range("F1").Select
    semaine = Range("F1").Value
    Windows("Retardcarnet2007.htm").Activate
    Worksheets(semaine).Activate
    Numcolonne = Numcolonne + 1
    Cells(Numligneseg, Numcolonne).Interior.Color = vbRed
    End If
    End If
    Unload export
    End Sub

    Et je seche sur la comparaison de 2 cellules vers une seule où sont concaténées, les valeures de la semaine dernière. Idéalement, je cherche à remplir de couleur rouge les retards qui ont été annoncé la semaine dernière.
    0
  3. Utilisateur anonyme
     
    Bonjour,

    allons y par section ! 

    Private Sub Exporter_Click()

    Dim Numligne As Integer, Numcolonne As Integer, Numcol As Integer
    Dim counter As Integer, counter2 As Integer
    Dim Numligneseg As Integer, Numcolonneseg As Integer
    Dim CelluleA As String, CelluleB As String
    Dim seg As String, segment As String, Semaine As String
    Dim feuilleExiste As Boolean, Feuille As Worksheet, NomFeuille As String

    ' Initialisation
    counter = 0: counter2 = 0
    Numligneseg = 5: Numcolonneseg = 1
    Numcolonne = 3: Numligne = 5: Numcol = 4
    CelluleA = 0: CelluleB = 0: seg = 0
    Semaine = 0: segment = 0: feuilleExiste = False

    Workbooks.Open Filename:="L:\Mes documents\Retardcarnet2007.htm"
    'Vérification de la présence de la feuille semaine
    Windows("Retards carnet 070615.xls").Activate
    Range("F1").Select
    Semaine = Range("F1").Value
    Windows("Retardcarnet2007.htm").Activate
    For Each Feuille In Worksheets
        If (Feuille.Name = Semaine) Then
            feuilleExiste = True
        End If
    Next Feuille
    If Not (feuilleExiste) Then
        ' Capture du nom de la feuille active
        NomFeuille = ActiveSheet.Name
        ' Création de la feuille semaine
        Sheets.Add.Name = Semaine
        'Sheets.Add
        Sheets("ORIGINAL").Select
        Cells.Select
        Selection.Copy
        Sheets("Feuil2").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        
        ' Ici je me perds !!!
        Range("A1:E1").Select       ' Nouvelle sélection
        Sheets("Feuil2").Select     ' Déjà sélectionné, c'est la feuille active
        Windows("Retards carnet 070615.xls").Activate   ' Déjà activé
        ' Je suspecte ici :
        Sheets(NomFeuille).Select
        Range("F1").Select
        Semaine = Range("F1").Value
        ActiveCell.Value = Semaine
        
        Windows("Retardcarnet2007.htm").Activate
        Sheets(Semaine).Select
        Range("A1").Value = "RETARD CARNET   -    Semaine" & Semaine
    
    Else


    Qu'en dis-tu ?

    Lupin
    0
  4. Geoffroy45 Messages postés 12 Statut Membre 1
     
    Merci pour ton aide, j'ai bien conscience qu'il y a des doublons dans mon code Je me chargerai de l'épurer aprés. Cependant, je cherche une astuce pour verifier la valeur des 2 cellules (dans mon code ses valeurs sont entrées dans les variables CelluleA et CelluleB) avec une autre cellule qui contient plusieurs valeurs concaténées. Est cepossible?
    0

Discussions similaires

Calcul de nbre de nuitees pour ch d'hotes
JCD22580 -
JCD22580 -

9 réponses
les 2 petits points sur le e ou sur le i
mimjca -
mimjca -

2 réponses
Découvrez pourquoi mes SMS affichent deux 'check' !
ric025 -
phil -

4 réponses