Aide macro suite...

G

Guillaume

Guest
Re-Bonjour,

J'essaye d'écrire une macro qui selectionne des données et les recopient dans une autre colonne mais j'ai un problème pour éliminer les données "redondantes". Pouvez vous m'aider ?

Merci beaucoup par avance

Guillaume

Voici ma macro (Mefci à Hervé pour le début de la macro) :

Public Sub Foot()
Dim c As Range
Dim ligne As Integer, colonne As Integer, a As Integer

'initialisation de la variable ligne
ligne = 2
a = 2
'pour chaque cellule de la colonne C de la ligne 1 à la derniere non vide
For Each c In Range("c1:c" & Range("c65000").End(xlUp).Row)
'Si dans la cellule on trouve "0 - 0"
If Not c.Find("0 - 0") Is Nothing Then
'alors pour colonne = 2 jusqu'à 4
For colonne = 2 To 4
' a la cellule (2,colonne+5) on place les valeurs de la ligne contenant "0 - 0"
Cells(ligne, colonne + 5) = Cells(c.Row, colonne)
Cells(a, 11) = Cells(c.Row, colonne)
If (colonne = 2 Or colonne = 4) Then
a = a + 1
End If
Next colonne
'incrémentation de la ligne, sinon on écrit toujours sur la même
ligne = ligne + 1
End If
Next c
End Sub
 

Pièces jointes

  • footessai.zip
    8.4 KB · Affichages: 12
  • footessai.zip
    8.4 KB · Affichages: 11
  • footessai.zip
    8.4 KB · Affichages: 12
A

albert

Guest
bonsoir guillaume,
fais un essai avec le code de zon

http://www.excel-downloads.com/html/French/forum/read.php?f=1&i=102206&t=96295

Function Doublons(T, ColT As Byte) 'Zon
Dim I&, J&, K&, Tablo As New Collection
Dim Temp()
For I = LBound(T, 1) To UBound(T, 1)
On Error Resume Next
Tablo.Add T(I, ColT), CStr(T(I, ColT))
If Err = 0 Then
ReDim Preserve Temp(1 To UBound(T, 2), 1 To J + 1)
For K = 1 To UBound(Temp)
Temp(K, J + 1) = T(I, K)
Next K
J = J + 1
End If
Next I
Doublons = IIf(J > 0, Temp, "Pas de doublons")
End Function
Function InverseTab(T, Optional Base As Byte = 0)
Dim Temp(), I&, J&
ReDim Temp(Base To UBound(T, 2), Base To UBound(T))
For I = LBound(T, 2) To UBound(T, 2)
For J = LBound(T) To UBound(T)
Temp(I, J) = T(J, I)
Next J
Next I
InverseTab = Temp
End Function

Sub Princ()
Dim Plage As Range
Dim T
Set Plage = Range([K2], [K9]) '.End(xlUp)) 'à adapter
T = Doublons(Plage.Value, 1) 'Doublons sure la 1 ere colonne
If IsArray(T) Then
T = InverseTab(T, 1)
With Plage
.Clear
.Cells(1, 1).Resize(UBound(T), UBound(T, 2)) = T
End With
Else: MsgBox T
End If
End Sub
 
G

Guillaume

Guest
Bonjour Hervé,

Je vais essayer de t'expliquer le but de ma macro :

J'ai un fichier avec tous les scores du championnat de foot et je voudrai connaître quand est ce que toute les équipes on fait au moins un match nul et pas plus...

Mon idée était de "scanner" la colonne des scores et faire des "copier-coller" des cellules environnantes du score lorsque il y a un match nul...mais je veux aussi créer une liste sur le coté qui s'incrémente des noms des équipes avec un maximum qui correspond au nombre d'équipe du championnat.

Pour moi les données "redondantes" c'est par exemple le nom d'une équipes qui apparaîtrait deux fois dans cette liste.
 
H

Hervé

Guest
bonsoir

Regarde en plièce jointe, je suis passé par une collection , on doit pouvoir le faire via un tableau variant.

Par contre comment gêres-tu les matchs nul 1-1 , 2-2 ????

Salut
Hervé
 

Pièces jointes

  • footessai.zip
    9.3 KB · Affichages: 15
  • footessai.zip
    9.3 KB · Affichages: 13
  • footessai.zip
    9.3 KB · Affichages: 13

Statistiques des forums

Discussions
312 400
Messages
2 088 086
Membres
103 711
dernier inscrit
mindo