Tri de numéro de tel. d'une feuille vers une autre

[jcf83]

Bonjour à tous !
J'ai écrit quelques lignes de Vbasic pour une petite appli Excel, mais je "patauge" un peu pour faire quelque chose de plus sérieux
Je viens donc vous demander un peu d'aide.
Je vous expose mon problème :
- deux feuilles Excel, Feuil1 et Feuil2

Sur la Feuil2, plus de 40.000 lignes de numéros de téléphones appelants et appelés, je dois pouvoir récupérer les données (date, heure d'appel et n° appelé)d'un numéro choisi par l'utilisateur.

Sur la Feuil1, je récupère les données, j'y ai inserré un bouton qui ouvre un Inputbox, dans lequel je renseigne le numéro de tel. choisi.

Ma procédure :

1/ elle renseigne la cellule A1 de la feuil1 avec le contenu de l'inputbox
1/ elle fais un copie du contenu de la feuil2 sur la feuil1
2/ elle colle sur la feuille 1
3/ elle supprime les lignes qui ne concernent pas mon numéro

Ça fonctionne très bien....... mais alors qu'est ce que c'est long.....

Ce que je voudrai faire :

Une boucle qui rechercherait (avec formule VLOOKUP par exemple) sur le feuil2 les cellules qui concernent le n° choisi dans l'inputbox, et viendrait les coller directement dans la feuil1, les unes en dessous des autres...... mais, c'est là que je bloque parce que j'ai du mal avec les boucles....

Pour être plus clair, je met en pièce jointe une copie (simplifié) de mon fichier.
Merci !

 

[job75]

Re : Tri de numéro de tel. d'une feuille vers une autre

Bonjour jcf83,

Il faut que la macro utilise le filtre automatique en Feuil2. Voici le code :

Private Sub CommandButton1_Click()
Dim num_tel As String
num_tel = InputBox("N° de téléphone recherché")
If num_tel = "" Then Exit Sub
Range("A2:D65536").Clear
Range("A1") = num_tel
With Sheets("Feuil2")
If Application.CountIf(.Range("A:A"), num_tel) = 0 Then MsgBox "N° de téléphone non trouvé": Exit Sub
.AutoFilterMode = False
.Range("A1").AutoFilter Field:=1, Criteria1:=num_tel
[COLOR="Red"].Range("A2:D65536").SpecialCells(xlVisible).Copy Range("A2")[/COLOR]
.Range("A1").AutoFilter
End With
End Sub

PS : mettre les largeurs de colonnes en Feuil1 à la bonne dimension

Edit : si vous préférez, vous pouvez remplacer la ligne en rouge par :

.Range("B2:D65536").SpecialCells(xlVisible).Copy Range("B2")

 

[skoobi]

Re : Tri de numéro de tel. d'une feuille vers une autre

Bonjour job75, jcf83,

Ci-joint une autre proposition (sans filtrer) mais cela implique que les N° soient déjà trier en feuille 2 colonne A comme dans l'exemple que tu as envoyé.

Bonne journée.

 

[bqtr]

Re : Tri de numéro de tel. d'une feuille vers une autre

Bonjour jcf83, job75, skoobi


Un exemple en passant par des tableaux, assez rapide en général:

Private Sub CommandButton1_Click()

Dim Message As String, num_tel As String
Dim tablo, Tablo2(), k As Long, x As Long, TabExist As Long

Message = "N° de téléphone recherché"
num_tel = InputBox(Message)

If num_tel = "" Then
  MsgBox "Recherche abandonnée.", vbInformation, "Fin :"
  Exit Sub
End If

With Sheets("Feuil2")
  tablo = .Range("A2:D" & .Range("A65536").End(xlUp).Row)
End With

x = 0

For k = 1 To UBound(tablo)
  If tablo(k, 1) = num_tel Then
     ReDim Preserve Tablo2(1 To 3, x)
     Tablo2(1, x) = Format(tablo(k, 2), "dd/mm/yyyy hh:mm")
     Tablo2(2, x) = Format(tablo(k, 3), "hh:mm:ss")
     Tablo2(3, x) = tablo(k, 4)
     x = x + 1
  End If
Next

On Error Resume Next
TabExist = UBound(Tablo2, 2)
On Error GoTo 0

If TabExist = 0 Then
  MsgBox "Numéro introuvable.", vbCritical, "Fin de Recherhe"
  Exit Sub
End If

With Sheets("Feuil1")
  .Range("B2:D" & .Range("B65536").End(xlUp).Row + 1).Clear
  .Range("A1").Value = num_tel
  .Range("B2").Resize(UBound(Tablo2, 2) + 1, UBound(Tablo2, 1)) = Application.Transpose(Tablo2)
End With

End Sub

A+

 

[jcf83]

Re : Tri de numéro de tel. d'une feuille vers une autre

Merci à tous pour votre aide, j'ai tout relevé, je vais aller essayer vos solutions (je travaille sur un autre PC....) et je reviendrais vous dire !

 

[jcf83]

Re : Tri de numéro de tel. d'une feuille vers une autre

Encore merci à vous, c'est tout bon, ça fonctionne.

J'ai en fin de compte adapté la solution de Skoobi

A bientôt pour de nouvelles aventures

Bonne journée !