Discussion :

[tamtam64]

Bonjour,

En gros je recherche une methode algorithmique pour parcourire une colonne et d'ajouter les devises qui sont differentes de l'euros , usd et jpy . Mon probleme c'est que mon code marche pour une monnaie de plus , et en supposant que ma colonne soit rangée. On peut imaginer qu'il trouve une nouvelle monnaie GBP puis apres de l'euros puis encore du GBP alors il va le recompter , car il ne fait pas parti de mes conditions. Peut etre alors un test , sur le fait que ce que l'on rajoute doit etre different de mes conditions + des monnais que j'ai rajouté a mon tableau. Enfin j'ai un peu du mal a coder un truc propre.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
With xlsheet
    NbL = .Range("D" & Rows.Count).End(xlUp).Row
    Set AllRange = .Range(.Range("D11"), .Range("D" & NbL))
End With
    'on recupere le tableau des devises non travaillées
For Each MyRange In AllRange
    MyRange.Select
    If Not MyRange.Value = "EUR" And Not MyRange.Value = "JPY" And Not MyRange.Value = "USD" 
        i = i + 1
        ReDim Preserve TabCurrency(i)
        TabCurrency(i) = MyRange.Value
    End If
Next MyRange

[kiki29]

Salut, voir du côté de Collection ou Dictionary ?

[tamtam64]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function dicoCurrency(ByVal Source As String) As Dictionary
    'definition variables
Dim RangeTotal As Range, MyRange As Range
Dim MyDico As New Dictionary
Dim xlsheet As Worksheet
Dim My_Link As Link
Set xlsheet = ThisWorkbook.Worksheets("")
    'Creation dico
With xlsheet
    Set RangeTotal = .Range(.Range("A1").Offset(1), .Range("A1").End(xlDown))
    'creation dico
For Each MyRange In RangeTotal
    If Not MyDico.Exists(MyRange.Value) Then
        MyDico.Add MyRange.Value, MyRange.Value
    End If
Next MyRange
End With
    'attribution et vidage
Set DicoCurrency = MyDico
Set MyDico = Nothing
End Function

et apres je parcours les clefs , merci j'avais meme pas pensé a ca merci beaucoup kiki
par contre ton idee de collection ca m'intertesse, je vois pas ce que tu dis

[Theze]

Bonjour,

Là, je ne suis pas certain d'avoir tout compris. Tu souhaites récupérer les noms des différentes monnaies en évitant 3 monnaies en particulier ?
Si c'est le cas, regarde ce code et adapte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
Sub Test()
 
    Dim Dico As Object
    Dim Cle As Variant
    Dim Plage As Range
    Dim Cel As Range
    Dim I As Long
 
    'en colonne D sur la feuille "Feuil1" à partir de la ligne 11
    With Worksheets("Feuil1")
 
        Set Plage = .Range(.Cells(11, 4), .Cells(.Rows.Count, 4).End(xlUp))
 
    End With
 
    'création de l'objet Dictionnaire
    Set Dico = CreateObject("Scripting.Dictionary")
 
    'initialise avec les trois monnaies à éviter
    Dico.Add "EUR", "EUR"
    Dico.Add "JPY", "JPY"
    Dico.Add "USD", "USD"
 
        'on recupere le tableau des devises non travaillées
    For Each Cel In Plage
 
            If Dico.exists(Cel.Value) = False Then
 
                Dico.Add Cel.Value, Cel.Value '<--ici, un offset permet la récup d'une valeur dans une autre colonne
 
            End If
 
    Next Cel
 
    'résultat, pour le test, dans la fenêtre d'exécution (Ctrl+G)
    For Each Cle In Dico.Keys
 
        Debug.Print "Valeur de la clé : " & Dico(Cle)
 
    Next Cle
 
End Sub

Hervé.

[joe.levrai]

Bonjour,

tu parles de dictionnaire, mais tu n'en utilises pas !
c'est confus dans ta méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Dic()
Dim MonDico
Dim Cell As Range
 
Set MonDico = CreateObject("Scripting.dictionary")
 
With Sheets("Feuil1")
    For Each Cell In .Range(.Range("D11"), .Range("D" & .Range("D" & Rows.Count).End(xlUp).Row)).Cells
        Select Case Cell.Value
            Case "EUR", "JPY", "USD"
 
            Case Else
                If Not MonDico.exists(Cell.Value) Then MonDico.Add Cell.Value, Cell.Value
        End Select
    Next Cell
End With
 
End Sub

il y a plein d'autres possibilités :

- filtre avancé avec extraction sans doublon
- copie de ta plage et RemoveDuplicates dans la nouvelle colonne
- etc ...

[tamtam64]

Bonjour,

tu parles de dictionnaire, mais tu n'en utilises pas !
c'est confus dans ta méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Dic()
Dim MonDico
Dim Cell As Range
 
Set MonDico = CreateObject("Scripting.dictionary")
 
With Sheets("Feuil1")
    For Each Cell In .Range(.Range("D11"), .Range("D" & .Range("D" & Rows.Count).End(xlUp).Row)).Cells
        Select Case Cell.Value
            Case "EUR", "JPY", "USD"
 
            Case Else
                If Not MonDico.exists(Cell.Value) Then MonDico.Add Cell.Value, Cell.Value
        End Select
    Next Cell
End With
 
End Sub

il y a plein d'autres possibilités :

- filtre avancé avec extraction sans doublon
- copie de ta plage et RemoveDuplicates dans la nouvelle colonne
- etc ...

Le truc c'est que la j'ai une valeur qui serait la meme que ma clef ce qui est un peu inutile non?
a la limite je peux tester juste avec la fonction isexist non? sans forcement creer un dictionnaire , car finanlement c'est un peu inutile sachant qu'a tout casser je vais avoir 10 clefs ....

[joe.levrai]

j'allais pas perdre du temps à faire un travail abouti

tu voulais un algo, tu l'as ?

[PMO2017]

Bonjour,

Essayez le code suivant qui emploie une Collection sans doublon

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub aa()
Dim AllRange As Range
Dim var
Dim i&
Dim A$
Dim Coll As New Collection
 
With ActiveSheet
  Set AllRange = .Range(.Range("D11"), .Range("D" & .Range("D" & Rows.Count).End(xlUp).Row))
End With
var = AllRange
 
'--- Collection (sans doublon) des devises non travaillées ---
For i& = 1 To UBound(var, 1)
  A$ = UCase(Trim(CStr(var(i&, 1))))
  If A$ <> "EUR" And A$ <> "JPY" And A$ <> "USD" Then
    On Error Resume Next
    Coll.Add Item:=A$, Key:=A$
    On Error GoTo 0
  End If
Next i&
 
'--- Visualiser la collection ---
If Coll.Count > 0 Then
  For i& = 1 To Coll.Count
    MsgBox Coll(i&)
  Next i&
End If
End Sub

[tamtam64]

Bonjour,

Là, je ne suis pas certain d'avoir tout compris. Tu souhaites récupérer les noms des différentes monnaies en évitant 3 monnaies en particulier ?
Si c'est le cas, regarde ce code et adapte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
Sub Test()
 
    Dim Dico As Object
    Dim Cle As Variant
    Dim Plage As Range
    Dim Cel As Range
    Dim I As Long
 
    'en colonne D sur la feuille "Feuil1" à partir de la ligne 11
    With Worksheets("Feuil1")
 
        Set Plage = .Range(.Cells(11, 4), .Cells(.Rows.Count, 4).End(xlUp))
 
    End With
 
    'création de l'objet Dictionnaire
    Set Dico = CreateObject("Scripting.Dictionary")
 
    'initialise avec les trois monnaies à éviter
    Dico.Add "EUR", "EUR"
    Dico.Add "JPY", "JPY"
    Dico.Add "USD", "USD"
 
        'on recupere le tableau des devises non travaillées
    For Each Cel In Plage
 
            If Dico.exists(Cel.Value) = False Then
 
                Dico.Add Cel.Value, Cel.Value '<--ici, un offset permet la récup d'une valeur dans une autre colonne
 
            End If
 
    Next Cel
 
    'résultat, pour le test, dans la fenêtre d'exécution (Ctrl+G)
    For Each Cle In Dico.Keys
 
        Debug.Print "Valeur de la clé : " & Dico(Cle)
 
    Next Cle
 
End Sub

Hervé.

Non en fait jer parcours une colonne avec des monnaies et je voudrais recuperer les monnaies qui sont differentes de l'usd l'euro le jpy, pour creer eventuellement un tableau (pas de pb) un tableau qui serait composé de ces autres monnaie, sans avoir de repetitions dedant a savoir ne pas me retrouver avec deux fois le nom de la monnaie dans ce tableau . merci a toi

Bonjour,

Essayez le code suivant qui emploie une Collection sans doublon

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub aa()
Dim AllRange As Range
Dim var
Dim i&
Dim A$
Dim Coll As New Collection
 
With ActiveSheet
  Set AllRange = .Range(.Range("D11"), .Range("D" & .Range("D" & Rows.Count).End(xlUp).Row))
End With
var = AllRange
 
'--- Collection (sans doublon) des devises non travaillées ---
For i& = 1 To UBound(var, 1)
  A$ = UCase(Trim(CStr(var(i&, 1))))
  If A$ <> "EUR" And A$ <> "JPY" And A$ <> "USD" Then
    On Error Resume Next
    Coll.Add Item:=A$, Key:=A$
    On Error GoTo 0
  End If
Next i&
 
'--- Visualiser la collection ---
If Coll.Count > 0 Then
  For i& = 1 To Coll.Count
    MsgBox Coll(i&)
  Next i&
End If
End Sub

Merci beaucoup , si tu as le temps apres pour m'en dire plus , ton code est tres formateur, mais le & et le $ servent a quoi?

[joe.levrai]

Ce qui est fait avec la collection est identique à ce qui est fait avec le dictionnaire

on a encore l'item et sa clé qui ont la même valeur

donc explique nous la différence de jugement que tu as entre les deux ?

un dictionnaire et une collection, c'est quasiment la même chose, avec des propriétés et méthodes similaires (parfois même identiques)

la différence majeure ? le temps de traitement

les collections sont plus longues que les dictionnaires, quand on les manipules
mais il faut avoir un sacré paquet d'éléments pour ressentir humainement la différence

[tamtam64]

Je viens de tester et effectivement je ne savais pas creer une collection donc merci beaucoup.
Je garde la syntaxe, mais alors quelle pourait etre l'utilite d'une collection si c'est plus lent et si finalement on peut meme pas mettre de valeur?
Peut etre qaund on crait une suite importante d'objet? c'est tres rare , finalement je comprend pourquoi j'en ai jamais vraiment vu dans des codes

[Marc-L]

Bonjour,

et on peut utiliser un dictionnaire interne en VBA en combinant variable tableau et fonction EQUIV de feuille de calculs
sans recourir à un dictionnaire externe ni a une collection.

Avec un classeur exemple en .xlsx (sans code) joint accompagné d'une explication exhaustive …


_____________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo