Tableau

[Spectroms]

Bonjour,

Voici mon codage ci dessous. Il permet de faire la liste (stocker dans Tableau) des valeurs de la 6eme colonne (Nom de personne) sans doublons.
Ainsi il scanne toutes les lignes de la 6eme colonne.
Il teste si la valeur de la cellule est dans la variable Tableau. Si pas de doublons détecté (grace à U), on rajoute la valeur dans le tableau, et on le redimensionne.
Bon c'est peut etre pas un code très optimisé mais ma question est très simple.
Le tableau créer possède qu'une colonne est plusieurs lignes Tableau(j), jaimerais simplement que mon tableau possède 2 colonnes (qui reste vide). Mais je n'arrive pas !
Pouvez vous m'aider ?
Merci davance

Dim Tableau
j = 0
Otmpligne=1

ReDim Preserve Tableau(j)

While (Sheets(1).Cells(Otmpligne, 6) <> '')
    u = False
    For i = 1 To j
    tmpi = Sheets(1).Cells(Otmpligne, 6)
        If Sheets(1).Cells(Otmpligne, 6) = Tableau(i) Then
          u = True
          Exit For
        End If
    Next i
    
    If u = False Then
      Tableau(j) = Sheets(1).Cells(Otmpligne, 6)
      j = j + 1
      ReDim Preserve Tableau(j)
    End If
    
    Otmpligne = Otmpligne + 1
Wend

 

[galopin01]

Bonsoir,
Voici une macro qui me semble répondre à ta demande:
Tablo est dimensionné pour 2 colonnes
Comme seule la deuxième dimension est redimensionnable les lignes sont la 2ème dimension :

Sub Test()
Dim Tablo()
j = 1
While (Sheets(1).Cells(j, 6) <> '')
u = False
For i = 1 To j
ReDim Preserve Tablo(1 To 2, 1 To j)
tmpi = Sheets(1).Cells(j, 6)
If Sheets(1).Cells(j, 6) = Tablo(1, j) Then
u = True
Exit For
End If
Next i

If u = False Then
Tablo(1, j) = Sheets(1).Cells(j, 6)
j = j + 1
End If
Wend
End Sub

Ok ?

 

[galopin01]

Oups,
Dans mon bricolage j'ai viré la contrôle de doublons : je t'ajuste ça incessament sous peu...
A+

 

[galopin01]

Bon,
Je t'ai remis ton contrôle de doublons :
J'ai refait une 'tite correction pour pas avoir droit à un ZOP d'enfer :

Sub Test()
Dim Tablo(), i%, j%, k%
k = 1
j = 1
While (Sheets(1).Cells(k, 6) <> '')
u = False
For i = 1 To j
ReDim Preserve Tablo(1 To 2, 1 To j)
If Sheets(1).Cells(k, 6) = Tablo(1, i) Then
u = True
Exit For
End If
Next i
If u = False Then
Tablo(1, j) = Sheets(1).Cells(k, 6)
j = j + 1
End If
k = k + 1
Wend
End Sub

A+

Message édité par: galopin01, à: 15/04/2005 21:25

 

[Spectroms]

Désolé, de répondre si tardivement.. le week-end !
Mais je n'oublie pas de te remercier sincèrement car ca fonctionne très bien maitenant. Merci beaucoup !