Problème code de recherche de la ligne d'une valeur

Le 17/04/2019 à 11:47

Bonjour,

Tout d'abord je vous explique rapidement le principe de mon code. Le but est d'ouvrir un autre tableur (0.xlsx) et de rechercher le numéro de ligne d'un code PCE qui est présent aussi sur le tableur principale (ces codes sont soit sous la forme "GI04589" ou sous al forme d'un numéro a 14 chiffres). Une fois le numéro de ligne trouver je l'utilise pour croiser des données entre les deux tableurs.

Seulement voilà rencontre un problème je n'arrive pas a faire trouver le numéro de ligne de manière efficace. Le code est ci-dessous :

'cccccccccccccccccc association des PCE à leur code PT5

 Dim AA1 As String

CAB = Application.WorksheetFunction.CountA(Sheets("Feuil2").Range("M:M"))
CAB = CAB + 1

File_Name = 0 '0
 Complete_name = File_Path & "\" & File_Name & ".xlsx"
 Workbooks.Open (Complete_name)

Dim k As Integer
k = 2

Do While k < CAB
 Windows(NF).Activate

Sheets("Feuil2").Range("M" & k).NumberFormat = "#"
AA1 = Sheets("Feuil2").Range("M" & k).Value

Windows(File_Name & ".xlsx").Activate

'Range("AA1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        ':=False, Transpose:=False
'Range("AA1").NumberFormat = "#"

Sheets("Feuil1").Range("A:Z").Select  'le problème vient de là !

Set Cel = Selection.Find(what:=AA1, LookIn:=xlValues, lookat:=xlPart)

If Not Cel Is Nothing Then

Dim P As String
P = AA1
Dim c As Object
Dim therow As String
Sheets("Feuil1").Range("A:Z").Select
Set c = Selection.Find(P)
therow = c.Row

 Windows(NF).Activate

Sheets("Feuil2").Cells(k, 17).Value = therow

Dim PT5 As Long

 PT5 = Sheets("Feuil2").Range("Q" & k).Value

Windows(File_Name & ".xlsx").Activate

Range("A" & PT5).Copy

Windows(NF).Activate

Sheets("Feuil2").Range("R" & k).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Else

Windows(NF).Activate

Sheets("Feuil2").Cells(k, 17).Value = "Introuvable"

End If

k = k + 1

Loop

Windows(File_Name & ".xlsx").Close

Le problème c'est que je suis obliger de sélectionner les cellule de A à Z est la recherche est donc ultra longue :

Sheets("Feuil1").Range("A:Z").Select

alors que la valeur que je recherche est dans la colonne W parce que si je ne sélectionne seulement cette colonne avec un range("W:W") ou un column("W) ma macro ne trouve pas toute les valeurs.

Est-ce que quelqu'un aurait la solution ?

Le 17/04/2019 à 12:08

Slt EnzoC,

à tester

'cccccccccccccccccc association des PCE à leur code PT5
 Dim AA1 As String
 CAB = Application.WorksheetFunction.CountA(Sheets("Feuil2").Range("M:M"))
CAB = CAB + 1

File_Name = 0 '0
 Complete_name = File_Path & "\" & File_Name & ".xlsx"
 Workbooks.Open (Complete_name)

Dim k As Integer
k = 2

Do While k < CAB
 Windows(NF).Activate

Sheets("Feuil2").Range("M" & k).NumberFormat = "#"
AA1 = Sheets("Feuil2").Range("M" & k).Value

Windows(File_Name & ".xlsx").Activate

'Range("AA1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        ':=False, Transpose:=False
'Range("AA1").NumberFormat = "#"

With Worksheets("Feuil1").Range("W:W") 
Set Cel = .Find(what:=AA1, LookIn:=xlValues, lookat:=xlPart)

If Not Cel Is Nothing Then

Dim P As String
P = AA1
Dim c As Object
Dim therow As String
.Range("A:Z").Select ' ici aussi il faut changer "A:Z" avec "W:W" ????
Set c = Selection.Find(P)
therow = c.Row

Windows(NF).Activate

Sheets("Feuil2").Cells(k, 17).Value = therow

Dim PT5 As Long

PT5 = Sheets("Feuil2").Range("Q" & k).Value

Windows(File_Name & ".xlsx").Activate

Range("A" & PT5).Copy

Windows(NF).Activate

Sheets("Feuil2").Range("R" & k).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Else

Windows(NF).Activate

Sheets("Feuil2").Cells(k, 17).Value = "Introuvable"

End If
End With

k = k + 1

Loop

Windows(File_Name & ".xlsx").Close

Le 17/04/2019 à 13:51

Non non sa ne marche pas. Je ne comprend pas pourquoi le code arrive a trouver une correspondance pour tous les cas quand j'élargis la plage à A:Z mais pas quand je centre la recherche sur W:W ?! j'ai remarqué que les cas qui posait problème se situais au delà de la ligne 70 000 est ce qu'il y a une limite de ligne lors de la sélection avec la fonction "range("w:w") ?

Le 17/04/2019 à 13:53

Le 17/04/2019 à 14:07

Voilà je t'ai joint le tableur principale le code se trouve sur l'userform " conversion" et j'ai juste extrait un bout du tableur 0.xlsx qui fait en réalité ^plus de 80 000 lignes.

Je suis arrivé a bidouillé un bout de code pour que sa marche mais bon c'est pas top si quelqu'un aurait une solution plus simple je suis preneur ! Pour l'instant au lieux de sélectionner la colonne W je sélectionne un intervalle de 3 colonnes qui comprend W et sa fonctionne ?? Dans le code je cherche la colonne qui contient les valeurs qui m’intéresse car ici c'est W mais c'est une liste générer automatiquement et les valeurs recherché sont susceptible d'être dans une autre colonne (des fois X ou R).

'------------------------------------- TEST -------------------------------

Dim colonnew As String
Dim colinf As String
Dim colsup As String

'----------------------------------------- borne inf intevralle

colonnew = Cells(1, [A1:AZ1].Find("*QE*", lookat:=xlWhole).Column).Column
colonnew = colonnew - 1

If colonnew = 1 Then
colonnew = "A"
ElseIf colonnew = 2 Then
colonnew = "B"
ElseIf colonnew = 3 Then
colonnew = "C"
ElseIf colonnew = 4 Then
colonnew = "D"
ElseIf colonnew = 5 Then
colonnew = "E"
ElseIf colonnew = 6 Then
colonnew = "F"
ElseIf colonnew = 7 Then
colonnew = "G"
ElseIf colonnew = 8 Then
colonnew = "H"
ElseIf colonnew = 9 Then
colonnew = "I"
ElseIf colonnew = 10 Then
colonnew = "J"
ElseIf colonnew = 11 Then
colonnew = "K"
ElseIf colonnew = 12 Then
colonnew = "L"
ElseIf colonnew = 13 Then
colonnew = "M"
ElseIf colonnew = 14 Then
colonnew = "N"
ElseIf colonnew = 15 Then
colonnew = "O"
ElseIf colonnew = 16 Then
colonnew = "P"
ElseIf colonnew = 17 Then
colonnew = "Q"
ElseIf colonnew = 18 Then
colonnew = "R"
ElseIf colonnew = 19 Then
colonnew = "S"
ElseIf colonnew = 20 Then
colonnew = "T"
ElseIf colonnew = 21 Then
colonnew = "U"
ElseIf colonnew = 22 Then
colonnew = "V"
ElseIf colonnew = 23 Then
colonnew = "W"
ElseIf colonnew = 24 Then
colonnew = "X"
ElseIf colonnew = 25 Then
colonnew = "Y"
ElseIf colonnew = 26 Then
colonnew = "Z"
ElseIf colonnew = 27 Then
colonnew = "AA"
ElseIf colonnew = 28 Then
colonnew = "AB"
ElseIf colonnew = 29 Then
colonnew = "AC"
ElseIf colonnew = 30 Then
colonnew = "AD"
End If

colinf = colonnew

'-----------------------------------------Borne sup intervalle

colonnew = Cells(1, [A1:AZ1].Find("*QE*", lookat:=xlWhole).Column).Column
colonnew = colonnew + 1

If colonnew = 1 Then
colonnew = "A"
ElseIf colonnew = 2 Then
colonnew = "B"
ElseIf colonnew = 3 Then
colonnew = "C"
ElseIf colonnew = 4 Then
colonnew = "D"
ElseIf colonnew = 5 Then
colonnew = "E"
ElseIf colonnew = 6 Then
colonnew = "F"
ElseIf colonnew = 7 Then
colonnew = "G"
ElseIf colonnew = 8 Then
colonnew = "H"
ElseIf colonnew = 9 Then
colonnew = "I"
ElseIf colonnew = 10 Then
colonnew = "J"
ElseIf colonnew = 11 Then
colonnew = "K"
ElseIf colonnew = 12 Then
colonnew = "L"
ElseIf colonnew = 13 Then
colonnew = "M"
ElseIf colonnew = 14 Then
colonnew = "N"
ElseIf colonnew = 15 Then
colonnew = "O"
ElseIf colonnew = 16 Then
colonnew = "P"
ElseIf colonnew = 17 Then
colonnew = "Q"
ElseIf colonnew = 18 Then
colonnew = "R"
ElseIf colonnew = 19 Then
colonnew = "S"
ElseIf colonnew = 20 Then
colonnew = "T"
ElseIf colonnew = 21 Then
colonnew = "U"
ElseIf colonnew = 22 Then
colonnew = "V"
ElseIf colonnew = 23 Then
colonnew = "W"
ElseIf colonnew = 24 Then
colonnew = "X"
ElseIf colonnew = 25 Then
colonnew = "Y"
ElseIf colonnew = 26 Then
colonnew = "Z"
ElseIf colonnew = 27 Then
colonnew = "AA"
ElseIf colonnew = 28 Then
colonnew = "AB"
ElseIf colonnew = 29 Then
colonnew = "AC"
ElseIf colonnew = 30 Then
colonnew = "AD"
End If

colsup = colonnew

Rechercher des sujets similaires à "probleme code recherche ligne valeur"