Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel faire une fonction avec une variable de type "collection"

faire une fonction avec une variable de type "collection"

4 réponses
Avatar
Alfred WALLACE
Bonsoir,

J'ai une SUB donnees_de_champ_unique()

qui contiend =E7=E0 :
Dim Tabentree, Sansdoublons As New Collection, II As Long, JJ As Long


Stop


Sheets("base compl=E8te").Visible =3D True
Sheets("base compl=E8te").Select
Sheets("base compl=E8te").Activate

' pour ce positionner =E0 la colonne concern=E9e dans la base
Cells(2, Sheets(nomfeuille).CBB_champ_de_page.ListIndex + 1).Select
Tabentree =3D Range(ActiveCell(), Cells(65536,
ActiveCell.Column).End(xlUp)).Value

No_Event =3D True
Sheets("base compl=E8te").Visible =3D False ' on ferme la feuille de
la base : pas besoin


For II =3D LBound(Tabentree, 1) To UBound(Tabentree, 1)
On Error Resume Next
Sansdoublons.Add Tabentree(II, 1), CStr(Tabentree(II, 1))
Next
On Error GoTo 0


For II =3D 1 To Sansdoublons.Count - 1
For JJ =3D II + 1 To Sansdoublons.Count
If Sansdoublons(II) > Sansdoublons(JJ) Then
Swap1 =3D Sansdoublons(II)
Swap2 =3D Sansdoublons(JJ)
Sansdoublons.Add Swap1, before:=3DJJ
Sansdoublons.Add Swap2, before:=3DII
Sansdoublons.Remove II + 1 'supprime l'item consid=E9r=E9
Sansdoublons.Remove JJ + 1 'supprime l'item consid=E9r=E9
End If
Next JJ
Next II

Sheets(nomfeuille).CBB_Donnee_de_page.Clear
For II =3D 1 To Sansdoublons.Count
Sheets(nomfeuille).CBB_Donnee_de_page.AddItem Sansdoublons(II)
Next
End Sub

=E7=E0 marche.

Sheets(nomfeuille).CBB_Donnee_de_page.list =3D Ma_fonction(sansdoublons)

je n'arrive pas =E0 d=E9clarer sansdoublons correctement pour que je
puisse le calculer dans
une fonction (comme dans la sub actuelle) et le passer comme parametre
de retour
afin d'initialiser la .list de ma CBB.


Voil=E0, c'est un peu compliquer, j'esp=E8re que je suis pas trop
brouillon...

Merci

Jos=E9


j'aimerai pouvoir utiliser cette sub ailleurs, pouvoir lui passer comme
parametre
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
docm
Bonjour Alfred WALLACE.

Peut-être comme ceci:
Function Ma_fonction(coll) As Variant

ReDim t(0)
For II = 1 To coll.Count
t(UBound(t)) = coll(II)
ReDim Preserve t(UBound(t) + 1)
Next

If UBound(t) > 0 Then
ReDim Preserve t(UBound(t) - 1)
End If

Ma_fonction = t
End Function

docm

"Alfred WALLACE" wrote in message
news:
Bonsoir,

J'ai une SUB donnees_de_champ_unique()

qui contiend çà :
Dim Tabentree, Sansdoublons As New Collection, II As Long, JJ As Long


Stop


Sheets("base complète").Visible = True
Sheets("base complète").Select
Sheets("base complète").Activate

' pour ce positionner à la colonne concernée dans la base
Cells(2, Sheets(nomfeuille).CBB_champ_de_page.ListIndex + 1).Select
Tabentree = Range(ActiveCell(), Cells(65536,
ActiveCell.Column).End(xlUp)).Value

No_Event = True
Sheets("base complète").Visible = False ' on ferme la feuille de
la base : pas besoin


For II = LBound(Tabentree, 1) To UBound(Tabentree, 1)
On Error Resume Next
Sansdoublons.Add Tabentree(II, 1), CStr(Tabentree(II, 1))
Next
On Error GoTo 0


For II = 1 To Sansdoublons.Count - 1
For JJ = II + 1 To Sansdoublons.Count
If Sansdoublons(II) > Sansdoublons(JJ) Then
Swap1 = Sansdoublons(II)
Swap2 = Sansdoublons(JJ)
Sansdoublons.Add Swap1, before:=JJ
Sansdoublons.Add Swap2, before:=II
Sansdoublons.Remove II + 1 'supprime l'item considéré
Sansdoublons.Remove JJ + 1 'supprime l'item considéré
End If
Next JJ
Next II

Sheets(nomfeuille).CBB_Donnee_de_page.Clear
For II = 1 To Sansdoublons.Count
Sheets(nomfeuille).CBB_Donnee_de_page.AddItem Sansdoublons(II)
Next
End Sub

çà marche.

Sheets(nomfeuille).CBB_Donnee_de_page.list = Ma_fonction(sansdoublons)

je n'arrive pas à déclarer sansdoublons correctement pour que je
puisse le calculer dans
une fonction (comme dans la sub actuelle) et le passer comme parametre
de retour
afin d'initialiser la .list de ma CBB.


Voilà, c'est un peu compliquer, j'espère que je suis pas trop
brouillon...

Merci

José


j'aimerai pouvoir utiliser cette sub ailleurs, pouvoir lui passer comme
parametre
Avatar
Alfred WALLACE
Bonjour docm, je suis désolé car je ne comprend pas ce que tu as
écris.

Je cherche à faire en sorte que la 'collection' déclarée comme çà
:
Dim Tabentree, Sansdoublons As New Collection

puisse être accessible partout dans mon projet.

J'ai un module de variables mais si j'essaye d'écrire dedans :
Public Dim Tabentree, Sansdoublons As New Collection

ben çà ne marche pas.

je ne sais (comprend) pas ce que tu as essayé de faire


Merci encore.
José



docm wrote:
Bonjour Alfred WALLACE.

Peut-être comme ceci:
Function Ma_fonction(coll) As Variant

ReDim t(0)
For II = 1 To coll.Count
t(UBound(t)) = coll(II)
ReDim Preserve t(UBound(t) + 1)
Next

If UBound(t) > 0 Then
ReDim Preserve t(UBound(t) - 1)
End If

Ma_fonction = t
End Function

docm

"Alfred WALLACE" wrote in message
news:
Bonsoir,

J'ai une SUB donnees_de_champ_unique()

qui contiend çà :
Dim Tabentree, Sansdoublons As New Collection, II As Long, JJ As Long


Stop


Sheets("base complète").Visible = True
Sheets("base complète").Select
Sheets("base complète").Activate

' pour ce positionner à la colonne concernée dans la base
Cells(2, Sheets(nomfeuille).CBB_champ_de_page.ListIndex + 1).Select
Tabentree = Range(ActiveCell(), Cells(65536,
ActiveCell.Column).End(xlUp)).Value

No_Event = True
Sheets("base complète").Visible = False ' on ferme la feuille de
la base : pas besoin


For II = LBound(Tabentree, 1) To UBound(Tabentree, 1)
On Error Resume Next
Sansdoublons.Add Tabentree(II, 1), CStr(Tabentree(II, 1))
Next
On Error GoTo 0


For II = 1 To Sansdoublons.Count - 1
For JJ = II + 1 To Sansdoublons.Count
If Sansdoublons(II) > Sansdoublons(JJ) Then
Swap1 = Sansdoublons(II)
Swap2 = Sansdoublons(JJ)
Sansdoublons.Add Swap1, before:=JJ
Sansdoublons.Add Swap2, before:=II
Sansdoublons.Remove II + 1 'supprime l'item considéré
Sansdoublons.Remove JJ + 1 'supprime l'item considéré
End If
Next JJ
Next II

Sheets(nomfeuille).CBB_Donnee_de_page.Clear
For II = 1 To Sansdoublons.Count
Sheets(nomfeuille).CBB_Donnee_de_page.AddItem Sansdoublons(II)
Next
End Sub

çà marche.

Sheets(nomfeuille).CBB_Donnee_de_page.list = Ma_fonction(sansdoublons)

je n'arrive pas à déclarer sansdoublons correctement pour que je
puisse le calculer dans
une fonction (comme dans la sub actuelle) et le passer comme parametre
de retour
afin d'initialiser la .list de ma CBB.


Voilà, c'est un peu compliquer, j'espère que je suis pas trop
brouillon...

Merci

José


j'aimerai pouvoir utiliser cette sub ailleurs, pouvoir lui passer comme
parametre


Avatar
anonymousA
Bonjour,

pourquoi tu ne lis pas tes messages précédents jusqu'au bout ?. Tu te
serais ainsi aperçu que je t'avais répondu hier sur ta demande de
variable publique.

Nonobstant, voici ci-dessous une possibilité tout à la fois de
décliner une collection en passant un argument de type range en
entrée et de récupérer la collection construite comme une variable
publique et dont les éléments sont donc exposés tout le temps de
l'ouverture du fichier tant qu'il ny a pas de réinitialisation.

Dans des modules standards, tu écris

Public Sansdoublons As New Collection

Sub mise_en_collection()

constitution Range("G1:G50000")

End Sub

Sub constitution(rng)

Tabentree = rng.Value
For II = LBound(Tabentree, 1) To UBound(Tabentree, 1)
On Error Resume Next
Sansdoublons.Add Tabentree(II, 1), CStr(Tabentree(II, 1))
Next
On Error GoTo 0

MsgBox Sansdoublons.Count
For II = 1 To Sansdoublons.Count - 1
For JJ = II + 1 To Sansdoublons.Count
If Sansdoublons(II) > Sansdoublons(JJ) Then
Swap1 = Sansdoublons(II)
Swap2 = Sansdoublons(JJ)
Sansdoublons.Add Swap1, before:=JJ
Sansdoublons.Add Swap2, before:=II
Sansdoublons.Remove II + 1 'supprime l'item considéré
Sansdoublons.Remove JJ + 1 'supprime l'item considéré
End If
Next JJ
Next II

End Sub

A+

Alfred WALLACE wrote:
Bonjour docm, je suis désolé car je ne comprend pas ce que tu as
écris.

Je cherche à faire en sorte que la 'collection' déclarée comme ç à
:
Dim Tabentree, Sansdoublons As New Collection

puisse être accessible partout dans mon projet.

J'ai un module de variables mais si j'essaye d'écrire dedans :
Public Dim Tabentree, Sansdoublons As New Collection

ben çà ne marche pas.

je ne sais (comprend) pas ce que tu as essayé de faire


Merci encore.
José



docm wrote:
Bonjour Alfred WALLACE.

Peut-être comme ceci:
Function Ma_fonction(coll) As Variant

ReDim t(0)
For II = 1 To coll.Count
t(UBound(t)) = coll(II)
ReDim Preserve t(UBound(t) + 1)
Next

If UBound(t) > 0 Then
ReDim Preserve t(UBound(t) - 1)
End If

Ma_fonction = t
End Function

docm

"Alfred WALLACE" wrote in message
news:
Bonsoir,

J'ai une SUB donnees_de_champ_unique()

qui contiend çà :
Dim Tabentree, Sansdoublons As New Collection, II As Long, JJ As Long


Stop


Sheets("base complète").Visible = True
Sheets("base complète").Select
Sheets("base complète").Activate

' pour ce positionner à la colonne concernée dans la base
Cells(2, Sheets(nomfeuille).CBB_champ_de_page.ListIndex + 1).Select
Tabentree = Range(ActiveCell(), Cells(65536,
ActiveCell.Column).End(xlUp)).Value

No_Event = True
Sheets("base complète").Visible = False ' on ferme la feuille de
la base : pas besoin


For II = LBound(Tabentree, 1) To UBound(Tabentree, 1)
On Error Resume Next
Sansdoublons.Add Tabentree(II, 1), CStr(Tabentree(II, 1))
Next
On Error GoTo 0


For II = 1 To Sansdoublons.Count - 1
For JJ = II + 1 To Sansdoublons.Count
If Sansdoublons(II) > Sansdoublons(JJ) Then
Swap1 = Sansdoublons(II)
Swap2 = Sansdoublons(JJ)
Sansdoublons.Add Swap1, before:=JJ
Sansdoublons.Add Swap2, before:=II
Sansdoublons.Remove II + 1 'supprime l'item considér é
Sansdoublons.Remove JJ + 1 'supprime l'item considér é
End If
Next JJ
Next II

Sheets(nomfeuille).CBB_Donnee_de_page.Clear
For II = 1 To Sansdoublons.Count
Sheets(nomfeuille).CBB_Donnee_de_page.AddItem Sansdoublons(II)
Next
End Sub

çà marche.

Sheets(nomfeuille).CBB_Donnee_de_page.list = Ma_fonction(sansdoublons)

je n'arrive pas à déclarer sansdoublons correctement pour que je
puisse le calculer dans
une fonction (comme dans la sub actuelle) et le passer comme parametre
de retour
afin d'initialiser la .list de ma CBB.


Voilà, c'est un peu compliquer, j'espère que je suis pas trop
brouillon...

Merci

José


j'aimerai pouvoir utiliser cette sub ailleurs, pouvoir lui passer comme
parametre




Avatar
JB
Fonction donnant une liste sans doublons triée:

http://cjoint.com/?hwwfGnRySb

Function SansDoublonsTrié(champ As Range)
Dim temp()
ReDim temp(1 To champ.Count)
j = 1
For i = 1 To champ.Count
témoin = Not IsError(Application.Match(champ(i), temp, 0))
If Not témoin And champ(i) <> "" Then temp(j) = champ(i): j = j
+ 1
Next i
Call tri(temp, 1, j - 1)
SansDoublonsTrié = Application.Transpose(temp)
End Function

Sub tri(a, gauc, droi) ' Quick sort
ref = a((gauc + droi) 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub



Cordialement JB


Bonsoir,

J'ai une SUB donnees_de_champ_unique()

qui contiend çà :
Dim Tabentree, Sansdoublons As New Collection, II As Long, JJ As Long


Stop


Sheets("base complète").Visible = True
Sheets("base complète").Select
Sheets("base complète").Activate

' pour ce positionner à la colonne concernée dans la base
Cells(2, Sheets(nomfeuille).CBB_champ_de_page.ListIndex + 1).Select
Tabentree = Range(ActiveCell(), Cells(65536,
ActiveCell.Column).End(xlUp)).Value

No_Event = True
Sheets("base complète").Visible = False ' on ferme la feuille de
la base : pas besoin


For II = LBound(Tabentree, 1) To UBound(Tabentree, 1)
On Error Resume Next
Sansdoublons.Add Tabentree(II, 1), CStr(Tabentree(II, 1))
Next
On Error GoTo 0


For II = 1 To Sansdoublons.Count - 1
For JJ = II + 1 To Sansdoublons.Count
If Sansdoublons(II) > Sansdoublons(JJ) Then
Swap1 = Sansdoublons(II)
Swap2 = Sansdoublons(JJ)
Sansdoublons.Add Swap1, before:=JJ
Sansdoublons.Add Swap2, before:=II
Sansdoublons.Remove II + 1 'supprime l'item considéré
Sansdoublons.Remove JJ + 1 'supprime l'item considéré
End If
Next JJ
Next II

Sheets(nomfeuille).CBB_Donnee_de_page.Clear
For II = 1 To Sansdoublons.Count
Sheets(nomfeuille).CBB_Donnee_de_page.AddItem Sansdoublons(II)
Next
End Sub

çà marche.

Sheets(nomfeuille).CBB_Donnee_de_page.list = Ma_fonction(sansdoublons)

je n'arrive pas à déclarer sansdoublons correctement pour que je
puisse le calculer dans
une fonction (comme dans la sub actuelle) et le passer comme parametre
de retour
afin d'initialiser la .list de ma CBB.


Voilà, c'est un peu compliquer, j'espère que je suis pas trop
brouillon...

Merci

José


j'aimerai pouvoir utiliser cette sub ailleurs, pouvoir lui passer comme
parametre