Détection erreur VBA Résolu/Fermé

Question

Bonjour, 

je travail avec trois onglets sur un fichier excel. le premier onglet(Feuil 1) contien des informations matricul et nom colone A et B respectivement. 

le Troiseme onglet (Feuil3) contient rien qu'une partie des matricules copiez collez dépuis l'onglet 1(Feuil1)

Le deuxieme onglet je veux afficher les résultats, c'est a dire une macro qui l'orsqu'elle parcoure longlet 3 elle parcoure en meme temps l'onglet 1 et si lors du parcoure des deux onglet 1 et 3 le numero matricule est identique alors elle vas afficher dans la feuil2 le nom qui est dans la colone B de la feuil1 et donc le matricul en colone A correspond au matricule sélectionez dans la feuil3

voici mon bout de code et mon fichier joint


 Sub tes()
  
  Dim sed As Integer
    
Dim chr As Integer

Dim alka As Integer


Dim i As Long


Dim j As Long


Dim k As Long



    
    'limite = Range("A65536").End(xlUp).Row
    
    Mide = Worksheets("Feuil3").Cells(Rows.Count, 1).End(xlDown).Row

    Ngouan = Worksheets("Feuil2").Cells(Rows.Count, 1).End(xlDown).Row
    
    ' variable pour la première boucle
    
    sed = 1
    
    ' variable pour la deuxième boucle
    
    chr = 1
    
    alka = 2
    
    
'For i = sed To Ngouan

'call = cells(i,1).Value


For j = chr To Mide


If (Cells(j, 1).Value = Sheets("Feuil1").Cells(Rows.Count, 1).Value) Then


For k = sed To Ngouan




Sheets("Feuil2").Cells(k, 1).Value = Sheets("Feuil1").Cells(Rows.Count, 1).ofset(0, 1)



Next k

End If

Next j
 
 'Next i
 
 End Sub

quand je le compile il n'ya pas d'érreur mais il prend trops de temps a compilé et n'affiche aucun résultat.

G_33 · Answer

Bonsoir

Il me semble que vous aviez déjà posté cette demande il y a quelque jours.
Et vous y avoir répondu.

sauf erreur de ma part.

Sinon montrez un fichier plus simple et plus compréhensible pour vous aider.

Cordialement

michel_m · Answer

Bonjour

Si tu veux la rapidité , essaies ce code
Option Explicit
Option Base 1

Sub comparer_matricule()
Dim Derlig As Long, Dico As Object, Lig As Long, Mat, Nom As String
Dim T_sh3(), T_out(), cptr As Long
Dim start As Single

start = Timer
Application.ScreenUpdating = False

With Sheets(1)
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     Set Dico = CreateObject("scripting.dictionary")
     For Lig = 1 To Derlig
          Mat = .Cells(Lig, "A")
          Nom = .Cells(Lig, "B")
          If Not Dico.exists(Mat) Then Dico.Add Mat, Nom
     Next
End With

With Sheets(3)
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     T_sh3 = Application.Transpose(.Range("A1:A" & Derlig).Value)
End With

cptr = 1
ReDim T_out(2, cptr)
For Lig = 1 To Derlig
     If Dico.exists(T_sh3(Lig)) Then
          ReDim Preserve T_out(2, cptr)
          T_out(1, cptr) = T_sh3(Lig)
          T_out(2, cptr) = Dico.Item(T_sh3(Lig))
          cptr = cptr + 1
     End If
Next

With Sheets(2)
     .Range("A1:B10000").Clear
     .Range("A1").Resize(cptr - 1, 2) = Application.Transpose(T_out)
     .Range("A1:B" & cptr - 1).Borders.Weight = xlThin
     .Select
End With
Application.ScreenUpdating = True
MsgBox "durée : " & Timer - start & " secondes"

End Sub
 

maquette:
https://www.cjoint.com/?3JerOfHg7Ms

Kikavely · Answer

Coooooolllll merci michel_m ton code marche parfaitement. 

parcontre j'éssai de le comprendre mais je bloque o niveau Application.Transpose

il marche parfaitement merci encore.

Détection erreur VBA

3 réponses

Discussions similaires