Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

L'union me fait pleurer

9 réponses
Avatar
merguez07
Bonjour à tous,

dans mon tableau j'ai dans la même colonne, un certain nombre de
cellules contenant la même valeur

pour travailler facilement avec toutes ces cellules identiques j'avais
eu l'idée de les regrouper dans un range par une union

par exemple si je voulais mettre dans mon range (que j'ai nommé "Uc")
toutes les cellules de la colonne 1 contenant le mot "Chat" je faisais

Set c = Worksheets("ma feuille").Columns(1).Find("Chat")
If Not c Is Nothing Then
Set Uc = c
premier = c.Address
Do
Set Uc = Union(Uc, c)
Set c = Worksheets("ma feuille").Columns(1).FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier


Dans la 1ere colonne de mon tableau il y a 8 cellules contenant le mot
"chat" mais ma procédure s’arrête à 4 (Uc.rows.count ne dépasse pas 4)
Pourtant lors du debuggage je le vois bien faire 8 fois la boucle mais
au bout de la quatrième, union ne fait plus l'union (si je puis dire)

Est ce une limitation?

merci de vos lumières


---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com

9 réponses

Avatar
MichD
Bonjour,

Tu peux utiliser ceci :


Si tu n'as pas une plage trop grande à unir, ça va sinon
le traitement s'allongera.

Comme tu ne dis pas ce que tu veux faire, difficile de te
proposer autre chose!

'---------------------------------------------
Sub test()
Dim Feuille As String
Dim C As Range, Rg As Range
Dim Trouve As Range, Adr As String

Feuille = "Feuil1"

With Worksheets(Feuille)
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
Set Trouve = .Find(What:="Chat", LookIn:=xlValues, LookAt:=xlWhole)
If Not Trouve Is Nothing Then
Adr = Trouve.Address
Do
If Rg Is Nothing Then
Set Rg = Trouve
Else
Set Rg = Application.Union(Rg, Trouve)
End If
Set Trouve = .FindNext(Trouve)
Loop Until Trouve.Address = Adr
End If
End With
End With
MsgBox Rg.Address

End Sub
'---------------------------------------------
Avatar
GL
Le 22/03/2014 15:57, merguez07 a écrit :
Bonjour à tous,

dans mon tableau j'ai dans la même colonne, un certain nombre de
cellules contenant la même valeur

pour travailler facilement avec toutes ces cellules identiques j'avais
eu l'idée de les regrouper dans un range par une union

par exemple si je voulais mettre dans mon range (que j'ai nommé "Uc")
toutes les cellules de la colonne 1 contenant le mot "Chat" je faisais

Set c = Worksheets("ma feuille").Columns(1).Find("Chat")
If Not c Is Nothing Then
Set Uc = c
premier = c.Address
Do
Set Uc = Union(Uc, c)
Set c = Worksheets("ma feuille").Columns(1).FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier


Dans la 1ere colonne de mon tableau il y a 8 cellules contenant le mot
"chat" mais ma procédure s’arrête à 4 (Uc.rows.count ne dépasse pas 4)
Pourtant lors du debuggage je le vois bien faire 8 fois la boucle mais
au bout de la quatrième, union ne fait plus l'union (si je puis dire)

Est ce une limitation?

merci de vos lumières



Pour compléter la réponse de MichD, j'ai une fonction FindAll
pour faire comme Find, mais qui renvoie toutes les occurrences
au lieu de la prochaine seulement :

Function FindAll(What, _
Optional Where As Variant, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional SearchDirection As XlSearchDirection = xlNext, _
Optional MatchCase As Boolean = False, _
Optional MatchByte As Boolean = False, _
Optional SearchFormat As Boolean = False) As Range
'LookIn can be xlValues or xlFormulas, _
LookAt can be xlWhole or xlPart, _
SearchOrder can be xlByRows or xlByColumns, _
SearchDirection can be xlNext, xlPrevious, _
MatchCase, MatchByte, and SearchFormat can be True or False. _
Before using SearchFormat = True, specify the appropriate settings _
for the Application.FindFormat object, e.g., _
Application.FindFormat.NumberFormat = "General;-General;""-"""
Dim R As Range, F As Range, c As Range

If IsMissing(Where) Then
On Error Resume Next
Set R = ActiveSheet.UsedRange
On Error GoTo 0
ElseIf TypeOf Where Is Range Then
If Where.Cells.Count = 1 Then
Set R = Where.Parent.UsedRange
Else
Set R = Where
End If
ElseIf TypeOf Where Is Worksheet Then
Set R = Where.UsedRange
Else
Exit Function
End If
If R Is Nothing Then Exit Function
With R.Areas(R.Areas.Count)
Set F = .Cells(.Cells.Count)
'This little 'dance' ensures we get the first matching cell in
the range first
End With
Set F = R.Find(What:=What, After:=F, _
LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, _
MatchByte:=MatchByte, SearchFormat:=SearchFormat)
If F Is Nothing Then Exit Function
Set c = F
Set FindAll = c
Do
Set FindAll = Application.Union(FindAll, c)
'Setting FindAll at the top of the loop ensures _
the result is arranged in the same sequence as _
the matching cells; the duplicate assignment of _
the first matching cell to FindAll being a small _
price to pay for the ordered result
Set c = R.Find(What:=What, After:=c, _
LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, _
MatchByte:=MatchByte, SearchFormat:=SearchFormat)
'FindNext is not reliable because it ignores the FindFormat settings
Loop Until c.Address = F.Address
End Function ' FindAll

USAGE : (par exemple)

' *************************************************
Sub toto()
Dim R As Range
Set R = FindAll("Chat", ActiveSheet.Columns(1))
R.Select
End Sub



Cordialement.
Avatar
merguez07
merci pour ta réponse

j'ai testé mais il me trouve nothing

je dois certainement mal utiliser la fonction

cordialement


Le 22/03/2014 16:54, GL a écrit :
Le 22/03/2014 15:57, merguez07 a écrit :
Bonjour à tous,

dans mon tableau j'ai dans la même colonne, un certain nombre de
cellules contenant la même valeur

pour travailler facilement avec toutes ces cellules identiques j'avais
eu l'idée de les regrouper dans un range par une union

par exemple si je voulais mettre dans mon range (que j'ai nommé "Uc")
toutes les cellules de la colonne 1 contenant le mot "Chat" je faisais

Set c = Worksheets("ma feuille").Columns(1).Find("Chat")
If Not c Is Nothing Then
Set Uc = c
premier = c.Address
Do
Set Uc = Union(Uc, c)
Set c = Worksheets("ma feuille").Columns(1).FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier


Dans la 1ere colonne de mon tableau il y a 8 cellules contenant le mot
"chat" mais ma procédure s’arrête à 4 (Uc.rows.count ne dépasse pas 4)
Pourtant lors du debuggage je le vois bien faire 8 fois la boucle mais
au bout de la quatrième, union ne fait plus l'union (si je puis dire)

Est ce une limitation?

merci de vos lumières



Pour compléter la réponse de MichD, j'ai une fonction FindAll
pour faire comme Find, mais qui renvoie toutes les occurrences
au lieu de la prochaine seulement :

Function FindAll(What, _
Optional Where As Variant, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional SearchDirection As XlSearchDirection = xlNext, _
Optional MatchCase As Boolean = False, _
Optional MatchByte As Boolean = False, _
Optional SearchFormat As Boolean = False) As Range
'LookIn can be xlValues or xlFormulas, _
LookAt can be xlWhole or xlPart, _
SearchOrder can be xlByRows or xlByColumns, _
SearchDirection can be xlNext, xlPrevious, _
MatchCase, MatchByte, and SearchFormat can be True or False. _
Before using SearchFormat = True, specify the appropriate settings _
for the Application.FindFormat object, e.g., _
Application.FindFormat.NumberFormat = "General;-General;""-"""
Dim R As Range, F As Range, c As Range

If IsMissing(Where) Then
On Error Resume Next
Set R = ActiveSheet.UsedRange
On Error GoTo 0
ElseIf TypeOf Where Is Range Then
If Where.Cells.Count = 1 Then
Set R = Where.Parent.UsedRange
Else
Set R = Where
End If
ElseIf TypeOf Where Is Worksheet Then
Set R = Where.UsedRange
Else
Exit Function
End If
If R Is Nothing Then Exit Function
With R.Areas(R.Areas.Count)
Set F = .Cells(.Cells.Count)
'This little 'dance' ensures we get the first matching cell in
the range first
End With
Set F = R.Find(What:=What, After:=F, _
LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, _
MatchByte:=MatchByte, SearchFormat:=SearchFormat)
If F Is Nothing Then Exit Function
Set c = F
Set FindAll = c
Do
Set FindAll = Application.Union(FindAll, c)
'Setting FindAll at the top of the loop ensures _
the result is arranged in the same sequence as _
the matching cells; the duplicate assignment of _
the first matching cell to FindAll being a small _
price to pay for the ordered result
Set c = R.Find(What:=What, After:=c, _
LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, _
MatchByte:=MatchByte, SearchFormat:=SearchFormat)
'FindNext is not reliable because it ignores the FindFormat settings
Loop Until c.Address = F.Address
End Function ' FindAll

USAGE : (par exemple)

' *************************************************
Sub toto()
Dim R As Range
Set R = FindAll("Chat", ActiveSheet.Columns(1))
R.Select
End Sub



Cordialement.








---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com
Avatar
GL
Le 22/03/2014 17:57, merguez07 a écrit :
merci pour ta réponse

j'ai testé mais il me trouve nothing

je dois certainement mal utiliser la fonction



????

La fonction s'utiliserait ainsi pour ton exemple :

Set Uc = FindAll("Chat",Worksheets("ma feuille").Columns(1))



cordialement


Le 22/03/2014 16:54, GL a écrit :
Le 22/03/2014 15:57, merguez07 a écrit :
Bonjour à tous,

dans mon tableau j'ai dans la même colonne, un certain nombre de
cellules contenant la même valeur

pour travailler facilement avec toutes ces cellules identiques j'avais
eu l'idée de les regrouper dans un range par une union

par exemple si je voulais mettre dans mon range (que j'ai nommé "Uc")
toutes les cellules de la colonne 1 contenant le mot "Chat" je faisais

Set c = Worksheets("ma feuille").Columns(1).Find("Chat")
If Not c Is Nothing Then
Set Uc = c
premier = c.Address
Do
Set Uc = Union(Uc, c)
Set c = Worksheets("ma feuille").Columns(1).FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier


Dans la 1ere colonne de mon tableau il y a 8 cellules contenant le mot
"chat" mais ma procédure s’arrête à 4 (Uc.rows.count ne dépasse pas 4)
Pourtant lors du debuggage je le vois bien faire 8 fois la boucle mais
au bout de la quatrième, union ne fait plus l'union (si je puis dire)

Est ce une limitation?

merci de vos lumières



Pour compléter la réponse de MichD, j'ai une fonction FindAll
pour faire comme Find, mais qui renvoie toutes les occurrences
au lieu de la prochaine seulement :

Function FindAll(What, _
Optional Where As Variant, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional SearchDirection As XlSearchDirection = xlNext, _
Optional MatchCase As Boolean = False, _
Optional MatchByte As Boolean = False, _
Optional SearchFormat As Boolean = False) As Range
'LookIn can be xlValues or xlFormulas, _
LookAt can be xlWhole or xlPart, _
SearchOrder can be xlByRows or xlByColumns, _
SearchDirection can be xlNext, xlPrevious, _
MatchCase, MatchByte, and SearchFormat can be True or False. _
Before using SearchFormat = True, specify the appropriate settings _
for the Application.FindFormat object, e.g., _
Application.FindFormat.NumberFormat = "General;-General;""-"""
Dim R As Range, F As Range, c As Range

If IsMissing(Where) Then
On Error Resume Next
Set R = ActiveSheet.UsedRange
On Error GoTo 0
ElseIf TypeOf Where Is Range Then
If Where.Cells.Count = 1 Then
Set R = Where.Parent.UsedRange
Else
Set R = Where
End If
ElseIf TypeOf Where Is Worksheet Then
Set R = Where.UsedRange
Else
Exit Function
End If
If R Is Nothing Then Exit Function
With R.Areas(R.Areas.Count)
Set F = .Cells(.Cells.Count)
'This little 'dance' ensures we get the first matching cell in
the range first
End With
Set F = R.Find(What:=What, After:=F, _
LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, _
MatchByte:=MatchByte, SearchFormat:=SearchFormat)
If F Is Nothing Then Exit Function
Set c = F
Set FindAll = c
Do
Set FindAll = Application.Union(FindAll, c)
'Setting FindAll at the top of the loop ensures _
the result is arranged in the same sequence as _
the matching cells; the duplicate assignment of _
the first matching cell to FindAll being a small _
price to pay for the ordered result
Set c = R.Find(What:=What, After:=c, _
LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, _
MatchByte:=MatchByte, SearchFormat:=SearchFormat)
'FindNext is not reliable because it ignores the FindFormat
settings
Loop Until c.Address = F.Address
End Function ' FindAll

USAGE : (par exemple)

' *************************************************
Sub toto()
Dim R As Range
Set R = FindAll("Chat", ActiveSheet.Columns(1))
R.Select
End Sub



Cordialement.








---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant
parce que la protection avast! Antivirus est active.
http://www.avast.com

Avatar
DanielCo
Bonjour,

Filtre la colonne et utilise le résultat du filtre.

Cordialement.

Daniel


Bonjour à tous,

dans mon tableau j'ai dans la même colonne, un certain nombre de cellules
contenant la même valeur

pour travailler facilement avec toutes ces cellules identiques j'avais eu
l'idée de les regrouper dans un range par une union

par exemple si je voulais mettre dans mon range (que j'ai nommé "Uc") toutes
les cellules de la colonne 1 contenant le mot "Chat" je faisais

Set c = Worksheets("ma feuille").Columns(1).Find("Chat")
If Not c Is Nothing Then
Set Uc = c
premier = c.Address
Do
Set Uc = Union(Uc, c)
Set c = Worksheets("ma feuille").Columns(1).FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier


Dans la 1ere colonne de mon tableau il y a 8 cellules contenant le mot "chat"
mais ma procédure s’arrête à 4 (Uc.rows.count ne dépasse pas 4)
Pourtant lors du debuggage je le vois bien faire 8 fois la boucle mais au
bout de la quatrième, union ne fait plus l'union (si je puis dire)

Est ce une limitation?

merci de vos lumières


---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant
parce que la protection avast! Antivirus est active.
http://www.avast.com
Avatar
merguez07
Bonjours à tous,

j'ai trouvé mon erreur

tout con

mon code est bon mais c'est le comptage des éléments contenus dans Uc
qui ne l'était pas
j'utilisais Uc.rows.count qui effectivement s’arrête à 4 pour je ne sais
quelle raison.
Par contre Uc.count contient le bon nombre d'éléments unis et me permet
donc de balayer ensuite chacun des éléments

cordialement




Le 22/03/2014 16:18, MichD a écrit :
Bonjour,

Tu peux utiliser ceci :


Si tu n'as pas une plage trop grande à unir, ça va sinon
le traitement s'allongera.

Comme tu ne dis pas ce que tu veux faire, difficile de te
proposer autre chose!

'---------------------------------------------
Sub test()
Dim Feuille As String
Dim C As Range, Rg As Range
Dim Trouve As Range, Adr As String

Feuille = "Feuil1"

With Worksheets(Feuille)
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
Set Trouve = .Find(What:="Chat", LookIn:=xlValues, LookAt:=xlWhole)
If Not Trouve Is Nothing Then
Adr = Trouve.Address
Do
If Rg Is Nothing Then
Set Rg = Trouve
Else
Set Rg = Application.Union(Rg, Trouve)
End If
Set Trouve = .FindNext(Trouve)
Loop Until Trouve.Address = Adr
End If
End With
End With
MsgBox Rg.Address

End Sub
'---------------------------------------------





---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com
Avatar
GL
Désolé, je n'avais pas vu le rapport du sujet avec l'UE...
Mais les autres non plus apparemment !
Avatar
merguez07
Non je ne fais pas de politique sur ce site.

je faisais juste un jeu de mot avec l'oignon

cordialement



Le 25/03/2014 17:14, GL a écrit :
Désolé, je n'avais pas vu le rapport du sujet avec l'UE...
Mais les autres non plus apparemment !




---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com
Avatar
Jacquouille
C'est vrai que l'Union, si elle n'est pas Jack, elle pourrait être UE.
Par contre, chez moi, elle fait la force. -))

Jacquouille, made in Belgium.



---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com