trouve

B

Bruce68

XLDnaute Impliqué
Bonsoir à tous
J'ai un tableau de 17 colonnes et dans colonne G j'ai: 1A,1B,1C,1D 2A,2B,2C,2D
3A, 3B,3C,3D, ce que je voudrais cette mettre dans une feuille toutes les lignes commençant par 1; 2 et 3 .En mettant 1 etoile cela ne fonctionne pas .
des 1A,1B,1C,1D 2A,2B,2C,2D 3A, 3B,3C,3D je peux en avoir des trentaine et je ne voudrais en recuperer que les 5 premiers :1*,2* et 3*.
Voici la macro que j'ai commmencée
Une ame charitable peut elle me dire la solution
For j = 3 To Nbr_Ligne + 2c,
If Cells(j, 7) = x Then
Range("A &j : R" & j).Select

x= 1*; 2*;3*

Bonne soirée à tous
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re : trouve

Bonsoir


Une proposition comme un début de piste
(à grandement améliorer)
Code: 
Sub xtest()
Dim tableau(100): Dim i As Byte: i = 1
For Each C In Range(Cells(1, 7), Cells(65536, 7).End(xlUp))
If C Like "1*" Or C Like "2*" Or C Like "3*" Then
tableau(i) = C: i = i + 1
End If
Next C
Application.ScreenUpdating = False: Worksheets("Feuil2").Activate: Cells(1, 1).Select
For Each x In tableau
ActiveCell = x: ActiveCell.Offset(1, 0).Activate
Next x
Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
fred65200

fred65200

XLDnaute Impliqué
Re : trouve

bonsoir
Une autre solution

Code: 
Public Const monMax As Long = 5
Sub LesPremiers()
'Il te faut deux feuilles
  'Feuil1 avec tes données en colonne G
 'Feuil2 vierge
Dim tab1(1 To monMax) As Variant
Dim tab2(1 To monMax) As Variant
Dim tab3(1 To monMax) As Variant
Dim a, b, c As Integer
'on initialise le compteur
a = 0: b = 0: c = 0
'on recherche la dernière ligne de la colonne G
DerLi = Sheets("Feuil1").Columns(7).Find("*", , , , , xlPrevious).Row
For Each cell In Sheets("Feuil1").Range("G1:G" & DerLi)
'on recherche le premier caractère
Select Case Left(cell.Value, 1)
Case 1:  If a < monMax Then a = a + 1: tab1(a) = cell.Value
Case 2:  If b < monMax Then b = b + 1: tab2(b) = cell.Value
Case 3:  If c < monMax Then c = c + 1: tab3(c) = cell.Value
End Select
'on applique une condition pour sortir de la boucle
If a + b + c = 3 * monMax Then Exit For
Next cell
'on colle les donnée dans la Feuil2
With Sheets("Feuil2")
  .Range("A1:C" & monMax + 1).ClearContents
  .[A1] = "Commence par 1"
  .[B1] = "Commence par 2"
  .[C1] = "Commence par 3"
  For i = 1 To monMax
  .Cells(i + 1, 1).Value = tab1(i)
  .Cells(i + 1, 2).Value = tab2(i)
  .Cells(i + 1, 3).Value = tab3(i)
  Next
End With
End Sub

Cordialement
 
Vote positif 0 Vote négatif
B

Bruce68

XLDnaute Impliqué
Re : trouve

Bonsoir à tous

Merci Staple1600 et Fred 65200 pour vos réponses, mais ce n'est pas exactement ce que je veux, voir le fichier joint et les explications.
Je veux recuperer la ligne entiere et les personnes doivent etres classées mais groupés par 1, 2, 3 4 5, 6 et 7 . (suivant leur cumul de points)
Bonne soirée à tous et merci de votre aide.
 

Pièces jointes

  • Test_4.zip
    33.6 KB · Affichages: 28
  • Test_4.zip
    33.6 KB · Affichages: 31
  • Test_4.zip
    33.6 KB · Affichages: 31
Vote positif 0 Vote négatif
B

Bruce68

XLDnaute Impliqué
Re : trouve

Bonjour à tous
Merci beaucoup Fred 65200 pour cette macro qui fonctione impeccablement bien
Mais voila j'ai pas 3 chiffres mais 7( 1a,1b,1c,1d-2a,2b,2c,2d-3a,3b,3c,3d-4a,4b,4c,4d-5a,5b,5c,5d-6a,6b,6c,6d- et 7 seul.
J'ai adapté la macro en conséquence mais dans la recopie sur la feuille serie je n'ai plus que les 1 et 2 apres je n'ai qu'une liste de # dans toutes les cases je pense que l'erreur vient dans la recopie des données, je n'ai pas arriver à comprendre le principe, en plus je ne suis pas un expert en VBA.
Je te remercie de ta contribution.
Ci dessous la macro que j'ai modifié

'Si tu veux les 6 premiers tu mets 6
Public Const monMax As Long = 5

Sub Serie()

Dim tab1(1 To monMax, 1 To 18) As Variant ' 1 to 18 = colonne A à R
Dim tab2(1 To monMax, 1 To 18) As Variant
Dim tab3(1 To monMax, 1 To 18) As Variant
Dim tab4(1 To monMax, 1 To 18) As Variant
Dim tab5(1 To monMax, 1 To 18) As Variant
Dim tab6(1 To monMax, 1 To 18) As Variant
Dim tab7(1 To monMax, 1 To 18) As Variant
Dim a, b, c, d, e, f, g As Integer
'on initialise le compteur
a = 0: b = 0: c = 0: d = 0: e = 0: f = 0: g = 0
'on recherche la dernière ligne de la colonne G
DerLi = Sheets("TOURNOI").Columns(7).Find("*", , , , , xlPrevious).Row
For Each cell In Sheets("TOURNOI").Range("G3:G" & DerLi)
'on évalue le premier caractère
Select Case Left(cell.Value, 1)
Case 1
If a < monMax Then
a = a + 1
'on remplie le premier tableau
For i = 1 To 18
tab1(a, i) = Sheets("TOURNOI").Cells(cell.Row, i).Value
Next
End If
Case 2
If b < monMax Then
b = b + 1
For i = 1 To 18
tab2(b, i) = Sheets("TOURNOI").Cells(cell.Row, i).Value
Next
End If
Case 3
If c < monMax Then
c = c + 1
For i = 1 To 18
tab3(c, i) = Sheets("TOURNOI").Cells(cell.Row, i).Value
Next
End If
Case 4
If d < monMax Then
d = d + 1
For i = 1 To 18
tab4(d, i) = Sheets("TOURNOI").Cells(cell.Row, i).Value
Next
End If
Case 5
If e < monMax Then
e = e + 1
For i = 1 To 18
tab5(e, i) = Sheets("TOURNOI").Cells(cell.Row, i).Value
Next
End If
Case 6
If f < monMax Then
f = f + 1
For i = 1 To 18
tab6(f, i) = Sheets("TOURNOI").Cells(cell.Row, i).Value
Next
End If
Case 7
If g < monMax Then
g = g + 1
For i = 1 To 18
tab7(g, i) = Sheets("TOURNOI").Cells(cell.Row, i).Value
Next
End If



End Select
'on applique une condition pour sortir de la boucle
If a + b + c + d + e + f + g = 7 * monMax Then Exit For
Next cell
'on colle les données dans la Serie
With Sheets("Serie")
.Range("A3:R" & 3 + 3 * monMax + 1).ClearContents
.Range("A3:R" & 2 + monMax).Value = tab1
.Range("A" & 3 + monMax + 1 & ":R" & 3 + 2 * monMax).Value = tab2
.Range("A" & 3 + 2 * monMax + 2 & ":R" & 4 + 3 * monMax).Value = tab3
.Range("A" & 3 + 2 * monMax + 2 & ":R" & 6 + 3 * monMax).Value = tab4
.Range("A" & 3 + 2 * monMax + 2 & ":R" & 8 + 3 * monMax).Value = tab5
.Range("A" & 3 + 2 * monMax + 2 & ":R" & 10 + 3 * monMax).Value = tab6
.Range("A" & 3 + 2 * monMax + 2 & ":R" & 12 + 3 * monMax).Value = tab7
End With
End Sub
 
Vote positif 0 Vote négatif
fred65200

fred65200

XLDnaute Impliqué
Re : trouve

Bonsoir,
Revoies ce qui suit

'on colle les données dans la Serie
With Sheets("Serie")
.Range("A3:R" & 3 + 3 * monMax + 1).ClearContents
.Range("A3:R" & 2 + monMax).Value = tab1
.Range("A" & 3 + monMax + 1 & ":R" & 3 + 2 * monMax).Value = tab2
.Range("A" & 3 + 2 * monMax + 2 & ":R" & 4 + 3 * monMax).Value = tab3
.Range("A" & 3 + 2 * monMax + 2 & ":R" & 6 + 3 * monMax).Value = tab4
.Range("A" & 3 + 2 * monMax + 2 & ":R" & 8 + 3 * monMax).Value = tab5
.Range("A" & 3 + 2 * monMax + 2 & ":R" & 10 + 3 * monMax).Value = tab6
.Range("A" & 3 + 2 * monMax + 2 & ":R" & 12 + 3 * monMax).Value = tab7
End With

j'ai un doute. pas le temps de regarder maintenant

@+
 
Vote positif 0 Vote négatif
fred65200

fred65200

XLDnaute Impliqué
Re : trouve

Essaie ça

With Sheets("Serie")
.Range("A3:R" & 8 + 7 * monMax).ClearContents
.Range("A3:R" & 2 + monMax).Value = tab1
.Range("A" & 3 + monMax + 1 & ":R" & 3 + 2 * monMax).Value = tab2
.Range("A" & 3 + 2 * monMax + 2 & ":R" & 4 + 3 * monMax).Value = tab3
.Range("A" & 3 + 3 * monMax + 3 & ":R" & 5 + 4 * monMax).Value = tab4
.Range("A" & 3 + 4 * monMax + 4 & ":R" & 6 + 5 * monMax).Value = tab5
.Range("A" & 3 + 5 * monMax + 5 & ":R" & 7 + 6 * monMax).Value = tab6
.Range("A" & 3 + 6 * monMax + 6 & ":R" & 8 + 7 * monMax).Value = tab7
End With

@+
 
Vote positif 0 Vote négatif
fred65200

fred65200

XLDnaute Impliqué
Re : trouve

J'y suis revenu
les macros un peu plus "synthétisées"

pour la beauté des tableaux
avec le tableau de tableaux.
Merci à Épaf pour son aide

Code: 
'Si tu veux les 6 premiers tu mets 6
Public Const monMax As Long = 5
Public Cell As Range
Public tab1(1 To monMax, 1 To 18) As Variant
Public tab2(1 To monMax, 1 To 18) As Variant
Public tab3(1 To monMax, 1 To 18) As Variant
Public tab4(1 To monMax, 1 To 18) As Variant
Public tab5(1 To monMax, 1 To 18) As Variant
Public tab6(1 To monMax, 1 To 18) As Variant
Public tab7(1 To monMax, 1 To 18) As Variant
Public Tablo As Variant

Sub LesPremiers()
'Macro moins rapide que la précédente à cause des trois boucles imbriquées
'Mais intéressante pour l'utilisation de tableaux
Dim a, b, c, d, e, f, g As Integer

'on "fige" l'écran
Application.ScreenUpdating = False

'on initialise le compteur
a = 0: b = 0: c = 0: d = 0: e = 0: f = 0: g = 0:  l = 2

'on recherche la dernière ligne de la colonne E
DerLi = Sheets("TOURNOI").Columns(5).Find("*", , , , , xlPrevious).Row

'le tableau de tableaux, M E R C I  à Épaf
Tablo = Array("", tab1, tab2, tab3, tab4, tab5, tab6, tab7)

For Each Cell In Sheets("TOURNOI").Range("E3:E" & DerLi)
  'on évalue le premier caractère
  Select Case Left(Cell.Value, 1)
    Case 1: If a < monMax Then RemplirTableaux a, 1   'voir la macro plus bas
    Case 2: If b < monMax Then RemplirTableaux b, 2
    Case 3: If c < monMax Then RemplirTableaux c, 3
    Case 4: If d < monMax Then RemplirTableaux d, 4
    Case 5: If e < monMax Then RemplirTableaux e, 5
    Case 6: If f < monMax Then RemplirTableaux f, 6
    Case 7: If g < monMax Then RemplirTableaux g, 7
  End Select
  'on applique une condition pour sortir de la boucle
  If a + b + c + d + e + f + g = 7 * monMax Then Exit For
Next Cell

'on efface
Sheets("Serie").Range("A3:R" & 8 + 7 * monMax).ClearContents
    
'la récupération des données avec 3 boucles imbriquées
For i = 1 To UBound(Tablo)
  For j = 1 To monMax ' ou UBound(tab1, 1)
    For k = 1 To UBound(tab1, 2)
      Sheets("Serie").Cells(j + l, k).Value = Tablo(i)(j, k)
    Next k
  Next j
  l = l + monMax + 1 ' + 1 pour sauter une ligne
Next i
' on actualise l'écran
Application.ScreenUpdating = True
End Sub
Sub RemplirTableaux(Lettre, Pos)
    Lettre = Lettre + 1
    For i = 1 To 18
      Tablo(Pos)(Lettre, i) = Sheets("TOURNOI").Cells(Cell.Row, i).Value
    Next
End Sub

Salutations
fred65200
 
Vote positif 0 Vote négatif
B

Bruce68

XLDnaute Impliqué
Re : trouve

Bonjour à tous
Merci beaucoup Fred pour ton devouement en ma faveur , ta nouvelle macro je n'ai pas encore testée , mais je vais le faire. J'ai réussi à modifié le collage des données en me servant des compteurs pour éviter plus 1 lignes vide entre les tableaux
Une Question: en me servant de cette macro ( en la modifiant ) peut on rechercher 1 ou plusieurs lettre à la place de 1chiffre + 1 lettre.
EX: S ou V ou JU ald 1A , 2A etc...( c'est la colonne H du fichier)
Si oui que faut il chager dans la macro ?

'on colle les données dans la feuille "Serie"
With Sheets("Serie")
.Range("A3:R" & 5 + 7 * monMax + 1).ClearContents
.Range("A4:R" & 3 + a).Value = tab1
.Range("A" & 4 + a + 1 & ":R" & 4 + a + b).Value = tab2
.Range("A" & 4 + a + b + 2 & ":R" & 5 + a + b + c).Value = tab3
.Range("A" & 4 + a + b + c + 3 & ":R" & 6 + a + b + c + d).Value = tab4
.Range("A" & 4 + a + b + c + d + 4 & ":R" & 7 + a + b + c + d + e).Value = tab5
.Range("A" & 4 + a + b + c + d + e + 5 & ":R" & 8 + a + b + c + d + e + f).Value = tab6
.Range("A" & 4 + a + b + c + d + e + f + 6 & ":R" & 9 + a + b + c + d + e + f + g).Value = tab7
End With
 
Vote positif 0 Vote négatif
fred65200

fred65200

XLDnaute Impliqué
Re : trouve

bonjour Bruce68

Tu peux rechercher ce que tu veux

la comparaison se fait avec
Select Case Left(Cell.Value, 1)
'on compara ici sur la première lettre de la valeur de cellule.

tu remplace 1 par 2
Select Case Left(Cell.Value, 2)
et Case 1 par Case "1A"

Dans la dernière macro, tu enlève +1 si tu ne veux pas sauter de ligne
l = l + monMax + 1 ' + 1 pour sauter une ligne

Par contre, tu auras toujours des blancs s'il y a moins de monMax (ici 5) élément dans ta liste de départ.

Dans ton classeur exemple, il y avait des sauts de lignes.

Cordialement
fred65200
 
Vote positif 0 Vote négatif
B

Bruce68

XLDnaute Impliqué
Re : trouve

Bonjour Fred65200
Merci encore pour ta collaboration ainsi que celle d'Epaf
J'ai modifie la macro en consequense pour rechercher V, S, D ,et JU j'ai juste change le N° de colonne et la lettre j'ai garde le reste intact.
J' ai bien la lettre dans: Select Case Left(Cell.Value, 1) mais la macro ne recopie aucune ligne Tableau blanc en fin de macro.
Ma colonne n'étant pas entierement pleine j'ai rajouté un A dans les emplacements vides: toujours tableau blanc.
Je ne comprend pas ?
Encore merci
 
Vote positif 0 Vote négatif

Discussions similaires

H
  • Question
XL 2016 Tri par formule
Réponses
9
Affichages
291
JHA
J
A
  • Résolu(e)
Microsoft 365 Correction d'un code vba
2
Réponses
22
Affichages
939
AD95
A
S
  • Question
Microsoft 365 comparaison texte
Réponses
5
Affichages
536
svn
S
counterbob
  • Question
Compter le nombre selon plusieurs critères
Réponses
7
Affichages
1 K
counterbob
counterbob
F
  • Question
Référence variable dans une formule
Réponses
9
Affichages
2 K
fredd
F
P
  • Résolu(e)
XL 2013 [Résolu] Graphique 2 axes sous forme de courbe avec plusieurs séries
Réponses
8
Affichages
2 K
Paradjanov
P
K
  • Résolu(e)
Microsoft 365 Autorisation
Réponses
2
Affichages
771
Keiko
K
K
  • Question
Microsoft 365 VBA - excel vers Acces
Réponses
0
Affichages
1 K
Keiko
K
R
  • Question
Bugs dans les graphiques radar plein ?
Réponses
3
Affichages
1 K
Gardien de phare
Gardien de phare
P
  • Question
VBA - Calcul selon nombre pair/impair
Réponses
2
Affichages
4 K
pochoco
P

Membres actuellement en ligne

27 membres et 361 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 805
Messages
2 092 286
Membres
105 326
dernier inscrit
figa