Tableau

Spectroms · 15 Avril 2005

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

Code:

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 · 15 Avril 2005

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 · 15 Avril 2005

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

galopin01 · 15 Avril 2005

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 · 18 Avril 2005

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 !

Tableau

Spectroms

Guest

galopin01

XLDnaute Occasionnel

galopin01

XLDnaute Occasionnel

galopin01

XLDnaute Occasionnel

Spectroms

Guest

Discussions similaires