[VB6] tableaux à 2 dimensions

Question

Bonjour,

j'ai encore et toujours des problèmes avec ces tableaux qui commencent sérieusement à me taper sur le système !.
J'ai une fonction dans laquelle je déclare :
    Dim MonTab() As Double
avec un peu plus loin dans la même fonction :
    ReDim MonTab(1, 2)
puis : Call ajoutCroissant_dans_liste(MonTab, x, y, UBound(MonTab))

J'ai récupéré et adapté a fonction ajoutCroissant_dans_liste trouvé dans les codes sources de vbfrance :
Sub ajoutCroissant_dans_liste(MonTab() As Double, x As Double, y As Double, tailletab As Integer)
    Dim i, j As Integer
    
    'parcours toutes les valeurs du tableau "tabl"
    For i = 0 To tailletab - 1
        'si la valeur a ajouter est > a une des valeurs du tableau tabl
        If valLongitude < tabLongitudes(i, 1) Then
            'augmente la taille du tableau de 1
            tailletab = tailletab + 1: ReDim Preserve tabLongitudes(tailletab, 2)
            'permute les valeurs du tableau "tabl" de -1
            For j = tailletab - 1 To i + 1 Step -1
                tabLongitudes(j, 1) = tabLongitudes(j - 1, 1)
                tabLongitudes(j, 2) = tabLongitudes(j - 1, 2)
            Next j
            'inscrit la valeur à sa place
            tabLongitudes(i, 1) = valLongitude
            tabLongitudes(i, 2) = valLatitude
            Exit Sub
        End If
        'verifie si la valeur trouvée est déja dans le tableau si oui sortir
        If tabLongitudes(i, 1) = valLongitude Then Exit Sub
    Next i
    ' si fin de tableau et pas trouvé c'est une valeur inférieure à toutes les autres valeurs du tableau
    tailletab = tailletab + 1: ReDim Preserve tabLongitudes(tailletab, 2)
    tabLongitudes(i, 1) = valLongitude
    tabLongitudes(i, 2) = valLatitude
End Sub

Lorsque je fais tourner mon appli, Vb me met une erreur "Indice en dehors de la plage" au niveau de la ligne rouge. Je ne sais pas du tout quoi faire...
Merci pour les réponses !

chaibat05 · Answer

salut,
initialises tailletab

<hr />I LIKE TO BE HERE WHEN I CAN .

* Rolling

kkhuet · Answer

j'ai modifié l'appel à la fonction :
 Call ajoutCroissant_dans_liste(MonTab, x, y, UBound(MonTab,1))
et j'ai aussi modifié la fonction ajoutCroissant_dans_liste en mettant 0 et 1 à la place de 1 et  2 (je m'étais planté en copiant la fonction... ) :

Sub ajoutCroissant_dans_liste(MonTab() As Double, x As Double, y As Double, tailletab As Integer)
    Dim i, j As Integer
    
    'parcours toutes les valeurs du tableau "MonTab"
    For i = 0 To tailletab - 1
        'si la valeur à ajouter est > a une des valeurs du tableau MonTab
        If x < MonTab(i, 0) Then
            'augmente la taille du tableau de 1
            tailletab = tailletab + 1: ReDim Preserve MonTab(tailletab, 2)
            'permute les valeurs du tableau "MonTab" de -1
            For j = tailletab - 1 To i + 1 Step -1
                MonTab(j, 0) = MonTab(j - 1, 0)
                MonTab(j, 1) = MonTab(j - 1, 1)
            Next j
            'inscrit la valeur à sa place
            MonTab(i, 0) = x
            MonTab(i, 1) = y
            Exit Sub
        End If
        'verifie si la valeur trouvée est déja dans le tableau si oui sortir
        If MonTab(i, 0) = x Then Exit Sub
    Next i
    ' si fin de tableau et pas trouvé c'est une valeur inférieure à toutes les autres valeurs du tableau
    tailletab = tailletab + 1: ReDim Preserve MonTab(tailletab, 2)
    MonTab(i, 0) = x
    MonTab(i, 1) = y
end sub

chaibat05 · Answer

tailletab n' étant pas initialisée
>elle est égale à 0
>tailletab-1=-1
>For i=0 to -1 => n' entre pas dans la boucle
>tailletab est toujours égale  -1>tailletab tailletab + 1:>    ReDim Preserve tabLongitudes(0, 2)

<hr />I LIKE TO BE HERE WHEN I CAN .

* Rolling

chaibat05 · Answer

post croisé !
mais est-ce que ça a marché pour toi ?

<hr />I LIKE TO BE HERE WHEN I CAN .

* Rolling

kkhuet · Answer

ah bein non ça ne fonctionne toujours pas

chaibat05 · Answer

tentes ceci au niveau de la declaration

Dim MonTab() As Double
avec un peu plus loin dans la même fonction :
    ReDim Preserve MonTab(1, 2)

<hr />I LIKE TO BE HERE WHEN I CAN .

* Rolling

chaibat05 · Answer

je pense qu' avec     ReDim MonTab(1, 2)
tu n' as plus la possibilité de le redimensionner
alors qu' avec ReDim Preserve MonTab(1, 2) tu peux toujours

<hr />I LIKE TO BE HERE WHEN I CAN .

* Rolling

kkhuet · Answer

toujours pas

chaibat05 · Answer

Alors le problème doit se situer ailleurs.
Notament au niveau de passage de tableau comme argument.
Fais des recherches à ce sujet, tu trouveras qûrement quelque chose.
En attendant essaies avec 
Sub ajoutCroissant_dans_liste(By Ref MonTab() As Double, x As Double, y As Double, tailletab As Integer)
ou
Sub ajoutCroissant_dans_liste(By Val MonTab() As Double, x As Double, y As Double, tailletab As Integer)

<hr />I LIKE TO BE HERE WHEN I CAN .

* Rolling

Kristof_Koder · Answer

Le problème vient de la ligne suivante
ReDim Preserve tabLongitudes(tailletab, 2)
Avec un tableau dynamique, tu ne peux modifier que la dernière dimension !
Tu dois donc faire ceci :
ReDim Preserve tabLongitudes(2,tailletab)
et bien sur inverser tous tes couples de coordonnées dans le reste de ton code

chaudier37 · Answer

Bonjour, je compatis à votgre problème parce que j'ai cherché longtemps la solution. j'ai trouvé une solution qui est semblable au résultat pour les tableaux à deux dimensions. cette fonction ajoute la ligne ou la colonne en fonction... voici la proédure que j'utilise pour mes cas... Option Explicit Dim MonTableau() As Variant Private Sub CommandButton1_Click() Range("A1").Select 'attention il faut que le range A2 ne soit pas vide sinon le curseur va en bas de la feuille et il y ara erreure... Dim DerniereLigne As Byte DerniereLigne = Range("A1").End(xlDown).Row Dim NbreDeLignes As Byte NbreDeLignes = DerniereLigne ReDim MonTableau(NbreDeLignes, 6) Call AffecterValeursTableau(NbreDeLignes) End Sub Sub AffecterValeursTableau(DerniereLigneTableau) Dim CompteurLignes As Byte Dim CompteurColonnes As Byte For CompteurLignes = 0 To DerniereLigneTableau For CompteurColonnes = 0 To 6 MonTableau(CompteurLignes, CompteurColonnes) = Cells(CompteurLignes + 5, CompteurColonnes + 1) Next CompteurColonnes Next CompteurLignes Dim a As String, b As String a = InputBox("entrez le numero de client dont vous voulez avoir les infos, " & Chr(10) & "0 : Si vous voulez avoir des infos sur la totalité des clients") b = InputBox("tapez le numéro correspondant à l'information désirée :" & Chr(10) & " 0 : N° ou nombre de clients" & Chr(10) & " 1 : quantité" & Chr(10) & " 2 : prix HT" & Chr(10) & " 3 : Taux de TVA" & Chr(10) & " 4 : montant TVA" & Chr(10) & " 5 : Total TTC") If a <> "" Then If b <> "" Then MsgBox "le résultat est : " & Round(MonTableau(a, b), 3) End If End If End Sub

[VB6] tableaux à 2 dimensions

11 réponses

Votre réponse

Discussions similaires