je voudrais mettre un "X"

Le
joseph84
Bonjour tout les monde

je voudrais mettre un "X" si dans la colonne source ne retrouve les
mots comme "sous" ou "sur" en met dans la colonne destination en met
un "X"

ces deux se trouve dans deux feuilles sur le meme classeurs:

calsseur 1

A B C
1 sous
2 dans
3 en dessus
4 sur


calsseur 2

A B C D E
1 X
2
3
4 X
5


voila mon code mais je crois qu il n est pas correct


Sub StopC()

Dim Rg As Range, Plg As Range, C As Range
Dim ColDestTyp As Integer, ColSourceTyp As Integer




With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

With Worksheets("Feuil2")
Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Pour déterminer la colonne source où sont les données
ColSourceTyp = Columns("B").Column - 1


'Pour déterminer la colonne où seront copiées les données
ColDestTyp = Columns("E").Column - 1



For Each C In Plg
If Not C.Offset(, ColSourceTyp).Value = "sous" Or C.Offset(,
ColSourceTyp).Value Then

'Or ColSourceTyp = "ouverte" Or ColSourceTyp = "complétée" Or
ColSourceTyp = "confirmée" Then
C.Offset(, ColDestTyp).Value = "X"

' If Not IsError(x) Then
' C.Offset(, ColDestPren).Value = Rg(x).Offset(,
ColSourcePren).Value
End If
Next C



End Sub



Merci
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 3
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #23287031
Bonjour,

Voici un exemple comment procéder.

Si dans la colonne C, j'ai supposé que la colonne avait une étiquette de colonne
il y a "sur" ou "sous", mettre un X dans la feuil2 de la colonne D dans la même
ligne où la donnée fut trouvée en feuil1

Si tu travailles sur des classeurs différents, tu n'as qu'à ajouter
le nom du classeur comme ceci : Workbooks("NomClasseur.xls").worksheets("Feuil1")...

'-------------------------------
Sub StopC()
Dim Rg As Range, Plg As Range
Application.ScreenUpdating = False

'Définir la plage de la feuille source : Colonne "C"
With Worksheets("Feuil1")
Set Rg = .Range("C1:C" & .Range("C65536").End(xlUp).Row)
End With

'Sur la plage source, application d'un filtre pour ne retenir
'les lignes désirées
With Rg
.AutoFilter field:=1, Criteria1:="Sur", Operator:=xlOr, Criteria2:="sous"
'Définir la plage qu'à retenu le filtre automatique
Set Plg = .Offset(1).Resize(Rg.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
End With

'Copie dans l'autre feuille, un X dans les lignes désignées
'de la colonne D
With Worksheets("Feuil2")
.Range(Plg.Address).Offset(, 1) = "X"
End With

'enlever le filtre automatique
Rg.AutoFilter
Application.ScreenUpdating = True
End Sub
'-------------------------------



MichD
--------------------------------------------
"joseph84" a écrit dans le message de groupe de discussion :


Bonjour tout les monde

je voudrais mettre un "X" si dans la colonne source ne retrouve les
mots comme "sous" ou "sur" en met dans la colonne destination en met
un "X"

ces deux se trouve dans deux feuilles sur le meme classeurs:

calsseur 1

A B C
1 sous
2 dans
3 en dessus
4 sur


calsseur 2

A B C D E
1 X
2
3
4 X
5


voila mon code mais je crois qu il n est pas correct


Sub StopC()

Dim Rg As Range, Plg As Range, C As Range
Dim ColDestTyp As Integer, ColSourceTyp As Integer




With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

With Worksheets("Feuil2")
Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Pour déterminer la colonne source où sont les données
ColSourceTyp = Columns("B").Column - 1


'Pour déterminer la colonne où seront copiées les données
ColDestTyp = Columns("E").Column - 1



For Each C In Plg
If Not C.Offset(, ColSourceTyp).Value = "sous" Or C.Offset(,
ColSourceTyp).Value Then

'Or ColSourceTyp = "ouverte" Or ColSourceTyp = "complétée" Or
ColSourceTyp = "confirmée" Then
C.Offset(, ColDestTyp).Value = "X"

' If Not IsError(x) Then
' C.Offset(, ColDestPren).Value = Rg(x).Offset(,
ColSourcePren).Value
End If
Next C



End Sub



Merci
joseph84
Le #23287011
On 15 avr, 12:03, "MichD"
Bonjour,

Voici un exemple comment procéder.

Si dans la colonne C, j'ai supposé que la colonne avait une étiquette de colonne
il y a "sur" ou "sous", mettre un X dans la feuil2 de la colonne D dans l a même
ligne où la donnée fut trouvée en feuil1

Si tu travailles sur des classeurs différents, tu n'as qu'à ajouter
le nom du classeur comme ceci :  Workbooks("NomClasseur.xls").worksheet s("Feuil1")...

'-------------------------------
Sub StopC()
Dim Rg As Range, Plg As Range
Application.ScreenUpdating = False

'Définir la plage de la feuille source : Colonne "C"
With Worksheets("Feuil1")
    Set Rg = .Range("C1:C" & .Range("C65536").End(xlUp).Row)
End With

'Sur la plage source, application d'un filtre pour ne retenir
'les lignes désirées
With Rg
    .AutoFilter field:=1, Criteria1:="Sur", Operator:=xlOr, Cri teria2:="sous"
    'Définir la plage qu'à retenu le filtre automatique
    Set Plg = .Offset(1).Resize(Rg.Rows.Count - 1).SpecialCells(xlC ellTypeVisible)
End With

'Copie dans l'autre feuille, un X dans les lignes désignées
'de la colonne D
With Worksheets("Feuil2")
    .Range(Plg.Address).Offset(, 1) = "X"
End With

'enlever le filtre automatique
Rg.AutoFilter
Application.ScreenUpdating = True
End Sub
'-------------------------------

MichD
--------------------------------------------
"joseph84"  a écrit dans le message de groupe de discussion :


Bonjour tout les monde

je voudrais mettre un "X" si dans la colonne source ne retrouve les
mots comme "sous" ou "sur" en met dans la colonne destination en met
un "X"

ces deux se trouve dans deux feuilles sur le meme classeurs:

calsseur 1

A     B        C
1              sous
2             dans
3             en dessus
4            sur

calsseur 2

A   B   C    D    E
1                     X
2
3
4                     X
5

voila mon code mais je crois qu il n est pas correct

Sub StopC()

Dim Rg As Range, Plg As Range, C As Range
Dim ColDestTyp As Integer, ColSourceTyp As Integer

With Worksheets("Feuil1")
    Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

With Worksheets("Feuil2")
    Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Pour déterminer la colonne source où sont les données
ColSourceTyp = Columns("B").Column - 1

'Pour déterminer la colonne où seront copiées les données
ColDestTyp = Columns("E").Column - 1

For Each C In Plg
    If Not C.Offset(, ColSourceTyp).Value = "sous" Or C.Offset(,
ColSourceTyp).Value Then

    'Or ColSourceTyp = "ouverte" Or ColSourceTyp = "complétée " Or
ColSourceTyp = "confirmée" Then
    C.Offset(, ColDestTyp).Value = "X"

'    If Not IsError(x) Then
'        C.Offset(, ColDestPren).Value = Rg(x).Offset(,
ColSourcePren).Value
    End If
Next C

End Sub

Merci



J ia oublier de spécifier que dans la colonne A il y a des ID alors je
voudrais que le ID soit pris en compte



calsseur 1


A B C
1234 sous
2895 dans
3654 en dessus
5926 sur


calsseur 2


A B C D E
1234 X
4321
3784
5926 X
5263
MichD
Le #23287121
Essaie comme ceci :

'---------------------------------------
Sub StopC()
Dim Rg As Range, Plg As Range
Dim C As Range, Trouve As Range

Application.ScreenUpdating = False

'Définir la plage de la feuille source : Colonne "C"
'IL est pris pour acquis que la ligne 1 contient les
'étiquettes de colonnes.

Application.ScreenUpdating = False
'Définir la plage source
With Worksheets("Feuil1")
With .Range("C1:C" & .Range("C65536").End(xlUp).Row)
'Ceci va restreindre le nombre de boucle nécessaire plus bas
.AutoFilter field:=1, Criteria1:="Sur", _
Operator:=xlOr, Criteria2:="sous"
'Définir la plage qu'à retenu le filtre automatique pour les boucles
Set Rg = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
End With
End With

'Définir la plage de destination
With Worksheets("Feuil2")
Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Pour chacune des valeur de la colonne 1 où il y a sur ou sous
'dans la colonne C, recherche dans la feuil2 col 1 s'il y a
'une correspondance, si oui, mettre un x dans la colonne E
For Each C In Rg
With Plg
Set Trouve = .Find(what:=C.Offset(, -2).Value, LookIn:=xlValues)
If Not Trouve Is Nothing Then
adr = Trouve.Address
End If
Do
Trouve.Offset(, 4) = "X"
Set Trouve = .FindNext(Trouve)
Loop Until Trouve.Address = adr Or Trouve Is Nothing
End With
Next
'Mettre fin au filtre automatique
Rg.AutoFilter
Application.ScreenUpdating = True
End Sub
'---------------------------------------

MichD
--------------------------------------------
joseph84
Le #23287481
On 15 avr, 13:15, "MichD"
Essaie comme ceci :

'---------------------------------------
Sub StopC()
Dim Rg As Range, Plg As Range
Dim C As Range, Trouve As Range

Application.ScreenUpdating = False

'D finir la plage de la feuille source : Colonne "C"
'IL est pris pour acquis que la ligne 1 contient les
' tiquettes de colonnes.

Application.ScreenUpdating = False
'D finir la plage source
With Worksheets("Feuil1")
    With .Range("C1:C" & .Range("C65536").End(xlUp).Row)
        'Ceci va restreindre le nombre de boucle n cessaire plus bas
        .AutoFilter field:=1, Criteria1:="Sur", _
            Operator:=xlOr, Criteria2:="sous"
        'D finir la plage qu' retenu le filtre automatique pour l es boucles
        Set Rg = .Offset(1).Resize(.Rows.Count - 1).SpecialCell s(xlCellTypeVisible)
    End With
End With

'D finir la plage de destination
With Worksheets("Feuil2")
    Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Pour chacune des valeur de la colonne 1 o il y a sur ou sous
'dans la colonne C, recherche dans la feuil2 col 1 s'il y a
'une correspondance, si oui, mettre un x dans la colonne E
For Each C In Rg
    With Plg
        Set Trouve = .Find(what:=C.Offset(, -2).Value, LookIn :=xlValues)
        If Not Trouve Is Nothing Then
            adr = Trouve.Address
        End If
        Do
            Trouve.Offset(, 4) = "X"
            Set Trouve = .FindNext(Trouve)
        Loop Until Trouve.Address = adr Or Trouve Is Nothing
    End With
Next
'Mettre fin au filtre automatique
Rg.AutoFilter
Application.ScreenUpdating = True
End Sub
'---------------------------------------

MichD
--------------------------------------------



Merci Michd pour ton aide

j ai un petit probleme je vois que la boucle ne fonctionne pas bien
parce que quand il ne touve de valeur similaire au critaire il affiche
une erreur
ccomme tu peux le voir dans le code je l ai un peux changer pour
ajouter d autres critaire et aussi pour changer l emplacement de mes
colonnes source et distination


CODE:


Sub StopC()
Dim Rg As Range, Plg As Range
Dim C As Range, Trouve As Range


Application.ScreenUpdating = False


'D finir la plage de la feuille source : Colonne "C"
'IL est pris pour acquis que la ligne 1 contient les
' tiquettes de colonnes.


Application.ScreenUpdating = False
'D finir la plage source
With Worksheets("Feuil1")
With .Range("C1:C" & .Range("C65536").End(xlUp).Row)
'Ceci va restreindre le nombre de boucle n cessaire plus bas
.AutoFilter field:=1, Criteria1:="sous", _
Operator:=xlOr, Criteria2:="sur", _
Operator:=xlOr, Criteria3:="en dessous", _
Operator:=xlOr, Criteria4:="en dessus"

'D finir la plage qu' retenu le filtre automatique pour les
boucles
Set Rg = .Offset(1).Resize(.Rows.Count -
1).SpecialCells(xlCellTypeVisible)
End With
End With


'Définir la plage de destination
With Worksheets("Feuil2")
Set Plg = .Range("AH1:AH" & .Range("Ah65536").End(xlUp).Row)
End With


'Pour chacune des valeur de la colonne 1 o il y a sur ou sous
'dans la colonne C, recherche dans la feuil2 col 1 s'il y a
'une correspondance, si oui, mettre un x dans la colonne E
For Each C In Rg
With Plg
Set Trouve = .Find(what:=C.Offset(, -2).Value,
LookIn:=xlValues)
If Not Trouve Is Nothing Then
adr = Trouve.Address
End If
Do
Trouve.Offset(, 23) = "X"
Set Trouve = .FindNext(Trouve)
Loop Until Trouve.Address = adr Or Trouve Is Nothing
End With
Next
'Mettre fin au filtre automatique
Rg.AutoFilter
Application.ScreenUpdating = True
End Sub


Merci bcp
MichD
Le #23287571
Tu dois alors utiliser un filtre élaboré au lieu d'un filtre automatique
La feuil1 est réputée avoir une d'étiquette en C1 et les données
débutent en C2

'----------------------------------------
Sub StopC()
Dim Rg As Range, Plg As Range, Sh As Worksheet
Dim C As Range, Trouve As Range


Application.ScreenUpdating = False

'D finir la plage de la feuille source : Colonne "C"
'IL est pris pour acquis que la ligne 1 contient les
' tiquettes de colonnes.


Application.ScreenUpdating = False
'D finir la plage source
Set Sh = Worksheets("Feuil1")
With Sh
'Z1:Z2 est la zone de critère pour le filtre élaboré
'qui utilise une formule. Tu peux utiliser les 2 cellules
'de ton choix
.Range("Z1") = ""
.Range("Z2").Formula = "=OR(C2=""sous"",C2=""sur""," & _
"C2=""en dessous"",C2=""en dessus"")"

With .Range("C1:C" & .Range("C65536").End(xlUp).Row)
'Ceci va restreindre le nombre de boucle n cessaire plus bas
.AdvancedFilter xlFilterInPlace, Sh.Range("Z1:Z2")

'D finir la plage qu' retenu le filtre automatique pour les boucles
Set Rg = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
End With
End With

'Définir la plage de destination
With Worksheets("Feuil2")
Set Plg = .Range("AH1:AH" & .Range("Ah65536").End(xlUp).Row)
End With

'Pour chacune des valeur de la colonne 1 o il y a sur ou sous
'dans la colonne C, recherche dans la feuil2 col 1 s'il y a
'une correspondance, si oui, mettre un x dans la colonne E
For Each C In Rg
With Plg
Set Trouve = .Find(what:=C.Offset(, -2).Value, LookIn:=xlValues)
If Not Trouve Is Nothing Then
adr = Trouve.Address
End If
Do
Trouve.Offset(, 23) = "X"
Set Trouve = .FindNext(Trouve)
Loop Until Trouve.Address = adr Or Trouve Is Nothing
End With
Next
'Mettre fin au filtre élaboré
On Error Resume Next
With Sh
.Range("Z1") = ""
.Range("Z2") = ""
.ShowAllData
End With
Application.ScreenUpdating = True
End Sub
'----------------------------------------
joseph84
Le #23289471
On 15 avr, 16:16, "MichD"
Tu dois alors utiliser un filtre labor au lieu d'un filtre automatique
La feuil1 est r put e avoir une d' tiquette en C1 et les donn es
d butent en C2

'----------------------------------------
Sub StopC()
Dim Rg As Range, Plg As Range, Sh As Worksheet
Dim C As Range, Trouve As Range

Application.ScreenUpdating = False

'D finir la plage de la feuille source : Colonne "C"
'IL est pris pour acquis que la ligne 1 contient les
' tiquettes de colonnes.

Application.ScreenUpdating = False
'D finir la plage source
Set Sh = Worksheets("Feuil1")
With Sh
    'Z1:Z2 est la zone de crit re pour le filtre labor
    'qui utilise une formule. Tu peux utiliser les 2 cellules
    'de ton choix
    .Range("Z1") = ""
    .Range("Z2").Formula = "=OR(C2=""sous"",C2=""sur""," & _
                    "C2=""en dessous"",C2=""en de ssus"")"

    With .Range("C1:C" & .Range("C65536").End(xlUp).Row)
        'Ceci va restreindre le nombre de boucle n cessaire plus bas
        .AdvancedFilter xlFilterInPlace, Sh.Range("Z1:Z2")

        'D finir la plage qu' retenu le filtre automatique pour l es boucles
        Set Rg = .Offset(1).Resize(.Rows.Count - 1).SpecialCell s(xlCellTypeVisible)
    End With
End With

'D finir la plage de destination
With Worksheets("Feuil2")
    Set Plg = .Range("AH1:AH" & .Range("Ah65536").End(xlUp).Row)
End With

'Pour chacune des valeur de la colonne 1 o il y a sur ou sous
'dans la colonne C, recherche dans la feuil2 col 1 s'il y a
'une correspondance, si oui, mettre un x dans la colonne E
For Each C In Rg
    With Plg
        Set Trouve = .Find(what:=C.Offset(, -2).Value, LookIn :=xlValues)
        If Not Trouve Is Nothing Then
            adr = Trouve.Address
        End If
        Do
            Trouve.Offset(, 23) = "X"
            Set Trouve = .FindNext(Trouve)
        Loop Until Trouve.Address = adr Or Trouve Is Nothing
    End With
Next
'Mettre fin au filtre labor
On Error Resume Next
With Sh
    .Range("Z1") = ""
    .Range("Z2") = ""
    .ShowAllData
End With
Application.ScreenUpdating = True
End Sub
'----------------------------------------



Bonjour michd

j ai tenté par tout les moyens mais sa fonctionne pas je vois que le
code que tu as mis ne prend pas en considération que j ai une colonne
ID que se trouve sur les deux feuilles donc ils doivent matcher
exactement comme dans l exemple


Feuil 1

A B Z
1234 sous
2895 dans
3654 en dessus
5926 sur

Feuil 2

A B C D AH
1234 X
4321
3784
5926 X
5263

MErci
MichD
Le #23289551
fichier exemple : http://cjoint.com/?ADqtbDmhGgg



MichD
--------------------------------------------
isabelle
Le #23289621
bonjour joseph,

met cette formule sur la feuille 2 en cellule AH2

=SI(NON(ESTERREUR(EQUIV(INDEX(Feuil1!$Z$2:Z$5;EQUIV(A2;Feuil1!$A$2:$A$5;0));{"sous";"sur"};0)));"X";"")

--
isabelle

Le 2011-04-16 12:01, joseph84 a écrit :
j ai tenté par tout les moyens mais sa fonctionne pas je vois que le
code que tu as mis ne prend pas en considération que j ai une colonne
ID que se trouve sur les deux feuilles donc ils doivent matcher
exactement comme dans l exemple


Feuil 1

A B Z
1234 sous
2895 dans
3654 en dessus
5926 sur

Feuil 2

A B C D AH
1234 X
4321
3784
5926 X
5263

MErci

michel ou sam
Le #23289671
Bonjour, j'avais aussi ceci
=SI(ESTNUM(CHERCHE(INDEX(Feuil1!$A$2:$C$5;EQUIV(A2;Feuil1!$A$2:$A$5;0);3);"sousur";1));"X";"")
Michel

"isabelle" iocimk$421$
bonjour joseph,

met cette formule sur la feuille 2 en cellule AH2

=SI(NON(ESTERREUR(EQUIV(INDEX(Feuil1!$Z$2:Z$5;EQUIV(A2;Feuil1!$A$2:$A$5;0));{"sous";"sur"};0)));"X";"")

--
isabelle
isabelle
Le #23289741
salut sam,

la tienne est un poil plus courte ;-)
et en combinant les 2, c'est encore un poil plus court

=SI(ESTNUM(EQUIV(INDEX(Feuil1!$Z$2:Z$5;EQUIV(A2;Feuil1!$A$2:$A$5;0));{"sous";"sur"};0));"X";"")

--
isabelle

Le 2011-04-16 13:43, michel ou sam a écrit :
Bonjour, j'avais aussi ceci
=SI(ESTNUM(CHERCHE(INDEX(Feuil1!$A$2:$C$5;EQUIV(A2;Feuil1!$A$2:$A$5;0);3);"sousur";1));"X";"")
Michel

"isabelle" iocimk$421$

bonjour joseph,

met cette formule sur la feuille 2 en cellule AH2

=SI(NON(ESTERREUR(EQUIV(INDEX(Feuil1!$Z$2:Z$5;EQUIV(A2;Feuil1!$A$2:$A$5;0));{"sous";"sur"};0)));"X";"")

--
isabelle





Publicité
Poster une réponse
Anonyme