Range to Dictionary

Version imprimable

Range to Dictionary

Bonsoir

J'ai essayé de faire une fonction pour mettre le contenu d'une Range à 2 colonnes dans un Dictionary,en utilisant la 1ère colonne comme Key et la seconde comme Item.

Code:

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
Function RangeToDictionary(r As Range, endDate As Date, Optional startDate As Date = CDate("1 janvier 1800")) As Dictionary
' Converts a range containing 2 columns into a Dictionary, using the 1st column as the key and the 2nd as the value
' This function does NOT handle the case where there is a duplicate in the first column
' The first colums MUST contain something which can be converted into a Date format
' The second column MUST contain something which can be converted into a Double format
    Dim cel As Range
    Dim res As Dictionary
    Set res = New Dictionary
    For Each cel In Range(r.Range("A1"), r.Range("A1").End(xlDown))
    ' For each cell in the first column or r
        If IsError(CDate(cel.Value)) Or cel.Value = "" Or cel.Value = Null Then
        ' If the current cell does not contain a date
            MsgBox "The cel " & cel.Address & " does not contain a Date !" & vbNewLine & "[Value detected : " & cel.Value & "]"
            Exit For
        ElseIf IsError(CDbl(cel.Offset(1).Value)) Then
        ' If the current Item does not contain a Double
            MsgBox "The cel " & cel.Offset(1).Address & " does not contain a Double !" & vbNewLine & "[Value detected : " & cel.Offset(1).Value & "]"
            Exit For
        ElseIf DateDiff("d", CDate(cel.Value), endDate) >= 0 Then
        ' If the date contained in the current cell of the loop is newer than the end date
            MsgBox "We reached the end date. Some values in the range might be ommited"
            Exit For
        ElseIf DateDiff("d", CDate(cel.Value), startDate) > 0 Then
        ' If the date contained in the current cell of the loop is newer than the start date
            res.Add CDate(cel.Value), CDbl(cel.Offset(1).Value)
        End If
    Next cel
    RangeToDictionary = res
End Function

Par contre, quand je teste la fonction avec un petit appel bidon du genre

Code:

1
2
3
Sub test()
    MsgBox RangeToDictionary(Selection, CDate(Sheets("UserGuide").Range("DateFin")))
End Sub

ça me dit "Argument non facultatif". Où est l'erreur ??

Merci d'avance ;)

11/01/2012, 08h52
ZebreLoup

Un Dictionary n'est pas un paramètre de MsgBox, tout simplement

Et la dernière ligne de ta fonction doit être

Code:

Set RangeToDictionary = res

On utilise Set dès qu'il s'agit d'un objet et non d'une variable

Merci pour ton aide !
En changeant la dernière ligne, je n'ai plus ce problème.

Avec une autre modif (changement de DateDiff) j'obtiens ça :

Code:

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
Function RangeToDictionary(r As Range, endDate As Date, Optional startDate As Date = CDate("1 janvier 1800")) As Dictionary
' Converts a range containing 2 columns into a Dictionary, using the 1st column as the key and the 2nd as the value
' This function does NOT handle the case where there is a duplicate in the first column
' The first column MUST contain something which can be converted into a Date format
' The second column MUST contain something which can be converted into a Double format
    Dim cel As Range
    Dim res As Dictionary
    Set res = New Dictionary
    For Each cel In Range(r.Range("A1"), r.Range("A1").End(xlDown))
    ' For each cell in the first column or r
        If IsError(CDate(cel.Value)) Or cel.Value = "" Or cel.Value = Null Then
        ' If the current cell does not contain a date
            MsgBox "The cel " & cel.Address & " does not contain a Date !" & vbNewLine & "[Value detected : " & cel.Value & "]"
            Exit For
        ElseIf IsError(CDbl(cel.Offset(1).Value)) Then
        ' If the current Item does not contain a Double
            MsgBox "The cel " & cel.Offset(1).Address & " does not contain a Double !" & vbNewLine & "[Value detected : " & cel.Offset(1).Value & "]"
            Exit For
        ElseIf DateDiff("d", endDate, CDate(cel.Value)) >= 0 Then
        ' If the date contained in the current cell of the loop is newer than the end date
            MsgBox "We reached the end date. Some values in the range might be ommited"
            Exit For
        ElseIf DateDiff("d", startDate, CDate(cel.Value)) > 0 Then
        ' If the date contained in the current cell of the loop is newer than the start date
            res.Add CDate(cel.Value), CDbl(cel.Offset(0, 1).Value)
        End If
    Next cel
    Set RangeToDictionary = res
End Function

Le problème est maintenant que dans Range(r.Range("A1"), r.Range("A1").End(xlDown)), il prend en fait toute la colonne, et pas seulement ce qu'il y a dans r. Comment faire pour restreindre la Range parcourue à la "1ère colonne de r" ?

11/01/2012, 09h18
ZebreLoup

Code:

Range(r.Cells(1, 1), r.Cells(r.Rows, 1))
11/01/2012, 09h28
hydredelerne

Merci ;)