Problème de comparaison entre deux cellules

Posté par

Geoffroy45, le vendredi 13 juillet 2007 à 14:17:02

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

Répondre à Geoffroy45 Signaler ce message aux modérateurs Aller au dernier message

Ce message vous semble utile, votez !
Signaler ce message aux modérateurs

Lupin.A, le vendredi 13 juillet 2007 à 14:57:51

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

Répondre à Lupin.A

Ce message vous semble utile, votez !
Signaler ce message aux modérateurs

Geoffroy45, le mardi 17 juillet 2007 à 14:50:27

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.

Répondre à Geoffroy45

Ce message vous semble utile, votez !
Signaler ce message aux modérateurs

Lupin.A, le mercredi 18 juillet 2007 à 20:28:27

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

Répondre à Lupin.A

Ce message vous semble utile, votez !
Signaler ce message aux modérateurs

Geoffroy45, le jeudi 19 juillet 2007 à 09:04:49

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?

Répondre à Geoffroy45

Posez votre question Répondre

Trucs & astuces pertinents trouvés dans la base de connaissances

15/12 16h49	Kit de survie	Shell
03/01 14h00	Remplir une ligne ou une colonne avec une suite logique	Excel
22/08 16h19	[Excel] Ajouter une date fixe dans une cellule en 2 touches	Excel
15/09 11h07	[Excel] Restreindre l'accés aux cellules	Excel
18/12 20h18	[Logiciel libre] Installation firefox 2.0+java+flash	Logiciel libre

Plus d'astuces sur « Problème de comparaison entre deux cellules »

Discussions pertinentes trouvées dans le forum

22/02 10h20	Macro excel pour comparer 2 cellules	2
16/07 08h48	Comparer 2 cellules et supprimer en une : VBA	13
04/07 11h59	[Excel VBA] Comparaison entre 2 cellules	9
14/06 12h55	écrire dans 2 cellules automatiquement	7
10/06 19h59	Excell 2003 cellule vide	7

Plus de discussions sur « Problème de comparaison entre deux cellules »

Logiciels pertinents trouvés dans les téléchargements

	SuperCopier 2 - SuperCopier est un gestionnaire de copie de fichiers libre pour Windows, proposant des fonctionnalités non couvertes par le...	Catégorie: Gestion de fichiers Licence: Freeware/gratuit
	Foobar 2000 - Foobar2000 est un lecteur audio avancé pour les plateformes Microsoft Windows. Son interface graphique est volontairement...	Catégorie: Lecteurs audio Licence: Freeware/gratuit
	Visual Basic Express 2005 - Le langage de programmation Visual Basic est historiquement dans les gènes de la société Microsoft. Avec plus de 30.000...	Catégorie: Visual Basic Licence: Freeware/gratuit
	PowerArchiver 2001 - Power Archiver est un équivalent gratuit de WinZip avec des fonctionnalités en plus, avec une version en français !!	Catégorie: Compression/Décompression Licence: Freeware/gratuit

Plus de logiciels gratuits sur « Problème de comparaison entre deux cellules »

Produits relatifs

Acer Aspire 5315-202G12Mi Intel	Catégorie: Ordinateur portable	399.00 € Grosbill.com
AMD Athlon 64 X2	Catégorie: Processeur	29.40 € Rue du Commerce
AMD Athlon 64 1620	Catégorie: Processeur	31.00 € PriceMinister
Apple iPod Nano 4	Catégorie: Lecteur MP3	119.95 € PriceMinister

Plus de produits sur « Problème de comparaison entre deux cellules »