Recherche d'une valeur dans un tableau

Bonjour à tous,

J'aimerais trouver une valeur dans un tableau pour ensuite déclencher un traitement de données, pour cela j'utilise les deux fonctions :

Application.Match et Application.Index

mais voila une erreur d'exécution '5' est declenché :

Argument ou appel de procédure incorrect

Voila le code utilisé :

Sub test()
    Dim Txt(), TbRacc()
    Dim i As Long, r As Long, lr As Long, n$

    ReDim Txt(1 To 10)
    Txt(1) = "----->> Ksr Chl 0 [19]"
    Txt(2) = "----->> Ksr Chl 1 [21]"
    Txt(3) = "----->> Zmlt [30]"
    Txt(4) = "----->> Srg [4]"
    Txt(5) = "----->> Rchg [5]"
    Txt(6) = "----->> Hmd [26]"
    Txt(7) = "----->> Frn 0 [73]"
    Txt(8) = "----->> Frn 1 [89]"
    Txt(9) = "----->> Mdrs [15]"
    Txt(10) = "----->> Tghm [12]"

    For i = LBound(Txt) To UBound(Txt)

        'Scinder une ligne de txt
        nn = Split(Txt(i), " ")
        ' On récupère un nom
        ' et éviter d'avoir le chiffre en dernier
        ' dans certain noms (0,1 ou 2)
        If Len(nn(UBound(nn) - 1)) > 1 Then
            n = nn(UBound(nn) - 1)
        Else
            n = nn(UBound(nn) - 2)
        End If

        h = Split(Split(Txt(i), "[")(1), "]")(0)

        '        MsgBox "Ligne : " & Txt(i) & vbCrLf & _
                 "Site : " & n & vbCrLf & _
                 "Nbr raccordés : " & h

        ' Doublures de noms de sites
        ' Test si des noms se répètent dans le tableau Txt

        If IsInArray(n, Array("CC", "Trt", "Frn", "Sgr", "Ksr Chl")) Then
            EstDans = Application.Match(n, Application.Index(TbRacc, 1), 0)
            If IsError(EstDans) Then
                On Error GoTo 0
                r = r + 1
                lr = r
                ReDim Preserve TbRacc(1 To 2, 1 To r)

                TbRacc(1, r) = n: TbRacc(2, r) = TbRacc(2, r) + h
            Else
                TbRacc(2, lr) = TbRacc(2, lr) + h
            End If
        Else
            r = r + 1
            ReDim Preserve TbRacc(1 To 2, 1 To r)
            TbRacc(1, r) = n: TbRacc(2, r) = h
            '            MsgBox "Ajout du site : " & n & vbCrLf & _
                         "Avec Abn Raccor : " & h
        End If
    Next i
End Sub
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    Dim i
    For i = LBound(arr) To UBound(arr)
        '        If arr(i) = stringToBeFound Then
        If InStr(1, arr(i), stringToBeFound) > 0 Then
            IsInArray = True
            Exit Function
        End If
    Next i
    IsInArray = False

End Function

Merci d'avance.

Bonsoir,

As-tu remarqué que ton tableau "TbRacc()" n'est pas initialisé !

Chose que tu peux contrôler avant l'utilisation de la fonction "Match()" avec :

MsgBox Not (Not TbRacc())

Bonsoir Theze,

MsgBox Not (Not TbRacc())

Ca affiche 0

Et bien justement, il n'est pas initialisé !

Testes de cette façon et tu auras une valeur supérieure à 0 même si sa seule dimension est vide :

ReDim TbRacc(1 To 1)
MsgBox Not (Not TbRacc)

Ton tableau TbRacc() est sensé contenir quoi ?

Cette fois ça affiche :

105368888

Ton tableau TbRacc() est sensé contenir quoi ?

TbRacc à deux dimension, la première colonne contient des noms, la deuxième contient des chiffres.

Et où se trouvent ces valeurs ? Dans une feuille de calcul ou il faut les rentrer en "dur" ?

TbRacc est alimenté selon des critères.

On peut dire faire des sous totaux de valeurs en Txt() dans TbRacc().

De mon exemple :

Txt(1) = "----->> Ksr Chl 0 [19]"

Txt(2) = "----->> Ksr Chl 1 [21]"

Txt(3) = "----->> Zmlt [30]"

Txt(4) = "----->> Srg [4]"

Txt(5) = "----->> Rchg [5]"

Txt(6) = "----->> Hmd [26]"

Txt(7) = "----->> Frn 0 [73]"

Txt(8) = "----->> Frn 1 [89]"

Txt(9) = "----->> Mdrs [15]"

Txt(10) = "----->> Tghm [12]"

Le tableau TbRacc obtenu sera :

TbRacc(1, 1) = "Chl"

TbRacc(1, 2) = "Zmlt"

TbRacc(1, 3) = "Srg"

TbRacc(1, 4) = "Rchg"

TbRacc(1, 5) = "Hmd"

TbRacc(1, 6) = "Frn"

TbRacc(1, 7) = "Mdrs"

TbRacc(1, 8 ) = "Tghm"

TbRacc(2, 1) = 40 ' 19+21

TbRacc(2, 2) = 30

TbRacc(2, 3) = 4

TbRacc(2, 4) = 5

TbRacc(2, 5) = 26

TbRacc(2, 6) = 162 ' 73+89

TbRacc(2, 7) = 15

TbRacc(2, 8 ) = 12

Alors, plutôt avec un dictionnaire, résultat en colonne A et B de la feuille actrive :

Sub test()

    Dim Dico As Object
    Dim Cle As Variant
    Dim Txt() As String
    Dim Tbl
    Dim I As Long
    Dim N As String
    Dim H As Double

    ReDim Txt(1 To 10)
    Txt(1) = "----->> Ksr Chl 0 [19]"
    Txt(2) = "----->> Ksr Chl 1 [21]"
    Txt(3) = "----->> Zmlt [30]"
    Txt(4) = "----->> Srg [4]"
    Txt(5) = "----->> Rchg [5]"
    Txt(6) = "----->> Hmd [26]"
    Txt(7) = "----->> Frn 0 [73]"
    Txt(8) = "----->> Frn 1 [89]"
    Txt(9) = "----->> Mdrs [15]"
    Txt(10) = "----->> Tghm [12]"

    Set Dico = CreateObject("Scripting.Dictionary")

    For I = 1 To UBound(Txt)

        'Scinder une ligne de txt
       Tbl = Split(Txt(I), " ")
        ' On récupère un nom
       ' et éviter d'avoir le chiffre en dernier
       ' dans certain noms (0,1 ou 2)
       If Len(Tbl(UBound(Tbl) - 1)) > 1 Then
            N = Tbl(UBound(Tbl) - 1)
        Else
            N = Tbl(UBound(Tbl) - 2)
        End If

        H = CDbl(Split(Split(Txt(I), "[")(1), "]")(0))

        Dico(N) = Dico(N) + H

    Next I

    I = 0

    For Each Cle In Dico.Keys

        I = I + 1
        Cells(I, 1).Value = Cle
        Cells(I, 2).Value = Dico(Cle)

    Next Cle

End Sub

C'est vraiment simple comme code

Merci Theze