Fonction Find & Erreur 9
Bonjour à tous,
Apprenti VBiste sous Excel, je rencontre un bug dans l'utilisation d'une macro que je n'arrive pas à résoudre de moi-même en consultant votre forum (d'où mon enregistrement).
La macro qui pose problème est sensée importer des données d'une feuille sur une autre du même classeur, puis retrouver dans une autre feuille (toujours du même classeur) des informations complémentaires, qu'il doit ensuite concaténer.
La macro en question:
Sub Extraction_FC()
Dim wsChantier As Worksheet
Dim wsVora As Worksheet
Dim wsLA As Worksheet
Dim wsLS As Worksheet
Dim wsPO As Worksheet
Dim crChantier As Range
Dim crVora As Range
Dim crLA As Range
Dim crLS As Range
Dim crPO As Range
Set wsChantier = Sheets("fiche_chantier")
Set wsVora = Sheets("liste_vora")
Set wsLA = Sheets("la_extraction")
Set wsLS = Sheets("ls_extraction")
Set wsPO = Sheets("po_extraction")
Set crChantier = wsChantier.Cells(9, 1)
Set crVora = wsVora.Cells(6, 1)
Dim pProjet As Range
Dim ctProjet As Range
Dim nProjet As String
Dim nEOTP As String
Dim nUO As String
Dim nDomaine As String
Dim nTen As String
Dim nbOperations As Integer
Dim nbTroncons As Integer
Dim lTroncons As Single
Dim k As Integer
nProjet = wsChantier.Cells(2, 4).Value
nbOperations = WorksheetFunction.CountIf(wsVora.Range("A:A"), nProjet)
Do While Not IsEmpty(crVora)
If crVora.Value <> nProjet Then
Set crVora = crVora.Offset(1, 0)
Else
Exit Do
End If
Loop
If IsEmpty(crVora) Then
MsgBox "Le projet n'a pas été retrouvé dans la liste des VORA"
Exit Sub
End If
For i = 1 To nbOperations
crChantier.Offset(3 * (i - 1), 0).Value = "a"
For j = 1 To 20
crChantier.Offset(3 * (i - 1), j).Value = crVora.Offset(i - 1, j).Value
Next
Next
Do While Not IsEmpty(crChantier)
nTen = crChantier.Offset(0, 1).Value
nEOTP = crChantier.Offset(0, 2).Value
nDomaine = crChantier.Offset(0, 3).Value
nUO = crChantier.Offset(0, 4).Value
If nDomaine = "LA" Then
nbTroncons = WorksheetFunction.CountIf(wsLA.Range("A:A"), nProjet)
If nbTroncons = 0 Then
If nTen = "60k" Then
crChantier.Offset(0, 21).Value = "LA_OR_MOY_371" 'Nom Or
crChantier.Offset(1, 21).Value = 1 'Pondération OR
ElseIf nTension = "100k" Then
crChantier.Offset(0, 21).Value = "LA_OR_MOY_372" 'Nom OR
crChantier.Offset(1, 21).Value = 1 'Pondération OR
ElseIf nTension = "250k" Then
crChantier.Offset(0, 21).Value = "LA_OR_MOY_373" 'Nom OR
crChantier.Offset(1, 21).Value = 1 'Pondération OR
End If
Else
Set crLA = wsLA.Range("A:A").Find(nProjet, LookIn:=xlValues, Lookat:=xWhole, SearchDirection:=xlNext)
Set pProjet = wsLA.Range("A" & crLA.Row & ":A" & (crLA.Row + nbTroncons) & "")
k = 0
For Each ctProjet In pProjet
If ctProjet.Offset(0, 2).Value = nEOTP And ctProjet.Offset(0, 4).Value = nUO Then
crChantier.Offset(0, 21 + k).Value = ctProjet.Offset(0, 5).Value 'Nom OR
crChantier.Offset(1, 21 + k).Value = ctProjet.Offset(0, 6).Value 'Longueur Tronçon
k = k + 1
End If
Next ctProjet
End If
ElseIf nDomaine = "LS" Then
ElseIf nDomaine = "PO" Then
Else
MsgBox "Le domaine de l'opération n°" & i & " n'est pas reconnu, corrigez et recommencez."
Exit Sub
End If
wsChantier.Sort.SortFields.Clear
wsChantier.Sort.SortFields.Add Key:=Range(crChantier.Offset(0, 21), crChantier.Offset(0, 21 + k)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.wsChantier.Sort
.SetRange Range(crChantier.Offset(0, 21), crChantier.Offset(1, 21 + k))
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
For l = 1 To k
If crChantier.Offset(0, 20 + l).Value = crChantier.Offset(0, 21 + l).Value Then
crChantier.Offset(1, 20 + l).Value = crChantier.Offset(1, 20 + l).Value + crChantier.Offset(1, 21 + l).Value
Range(crChantier.Offset(0, 21 + l), crChantier.Offset(1, 21 + l)).Delete Shift:=xlToLeft
l = l - 1
End If
Next
Set crChantier = crChantier.Offset(3, 0)
Loop
End SubLa ligne posant problème est la ligne n°98:
Set crLA = wsLA.Range("A:A").Find(nProjet, LookIn:=xlValues, Lookat:=xWhole, SearchDirection:=xlNext)Excel me retourne une erreur 9 à cette ligne: "L'indice n'appartient pas à la sélection"
En suivant les variables, je confirme que la feuille wsLA et la variable nProjet sont valides, j'ai essayé en utilisant la fonction with, en change la plage ou encore en enlevant le "As Range" du Dim crLA As Range sans succès.
Je vous ai joint le classeur correspondant après avoir épuré les données et autres macros sans toucher à l'intégrité de celle-ci.
Si les informations ne sont pas suffisantes, faites le moi savoir.
Merci pour votre aide,
Très cordialement,
Maxime
Bonsoir Maxz
il manque un L à
Lookat:=xlWholeBOB71AU a écrit :il manque un L
Et dire que j'y ai passé la matinée ... Wow
Enfin bref merci beaucoup !
Re
il y a encore deux erreurs plus bas
Seras-tu les trouver ?
BOB71AU a écrit :Re
il y a encore deux erreurs plus bas
Seras-tu les trouver ?
Je ne suis pas sur si c'est bien de ces 2 parties la que tu parles, mais en faisant les modifs suivantes, ça marche:
With ActiveWorkbook.wsChantier.Sort-->
With wsChantier.SortFor l = 1 To k
If crChantier.Offset(0, 20 + l).Value = crChantier.Offset(0, 21 + l).Value Then
crChantier.Offset(1, 20 + l).Value = crChantier.Offset(1, 20 + l).Value + crChantier.Offset(1, 21 + l).Value
Range(crChantier.Offset(0, 21 + l), crChantier.Offset(1, 21 + l)).Delete Shift:=xlToLeft
l = l - 1
End If
Next-->
For l = 1 To k
If IsEmpty(crChantier.Offset(0, 20 + l).Value) Then
Exit For
End If
If crChantier.Offset(0, 20 + l).Value = crChantier.Offset(0, 21 + l).Value Then
crChantier.Offset(1, 20 + l).Value = crChantier.Offset(1, 20 + l).Value + crChantier.Offset(1, 21 + l).Value
crChantier.Offset(0, 21 + l).Delete Shift:=xlToLeft
crChantier.Offset(1, 21 + l).Delete Shift:=xlToLeft
l = l - 1
End If
NextMax