Erreur 9 - L'indice n'appartient pas à la sélection
Bonjour,
J'ai un petit problème qui vient d'apparaitre sur l'une de mes macros et je ne trouve pas comment le résoudre:
L'erreur se trouve sur cette ligne :
n = n + 1: réf(n) = WorksheetFunction.Index(aa, i, 0)Des idées?
'================================================================================================================
'Copier tableau dans "Liste étiquettes"
'================================================================================================================
Sheets("Analyse de risque (2)").Select
Columns("B:B").Delete
For Each curShape In ActiveSheet.Shapes
curShape.Delete
Next curShape
'----------------Incrémenter doublons--------------------------
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Dim aa, réf(), n&, i&, j%, réfer$
aa = ActiveSheet.Range("A1").CurrentRegion
n = WorksheetFunction.Sum(WorksheetFunction.Index(aa, 0, 1))
ReDim réf(n): n = 0
For i = 2 To UBound(aa)
If aa(i, 1) = 1 Then
n = n + 1: réf(n) = WorksheetFunction.Index(aa, i, 0)
Else
réfer = aa(i, 2) & " #"
For j = 1 To aa(i, 1)
aa(i, 2) = réfer & Format(j, "000")
n = n + 1: réf(n) = WorksheetFunction.Index(aa, i, 0)
Next j
End If
Next i
réf(0) = WorksheetFunction.Index(aa, 1, 0)
With Worksheets.Add(after:=ActiveSheet).Range("A1").Resize(n + 1, UBound(aa, 2))
.Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(réf))
.Columns.AutoFit
.HorizontalAlignment = xlCenter
.Borders.Weight = xlThin
End With
ActiveSheet.Name = "Liste étiquettes 2"Merci d'avance pour votre aide.
Bonjour,
Le code c'est bien mais le fichier qui pose problème c'est mieux car là, difficile d'être sûr de reproduire le classeur à l'identique !
Anonymise le classeur et postes-le.
bonjour,
edit : bonjour Theze
le message indique que n a une valeur supérieure à la dimension maximum de ton tableau ref().
quant à dire pourquoi, pour moi le code ne suffit pas à comprendre, il faudrait aussi les données.=> donc merci de mettre le fichier ou un fichier exemple dans lequel tu as pu reproduire le problème.
Bonjour, bonjour h2so4
Effectivement, l'index est hors limite car tu redimensionnes ton tableau :
ReDim réf(n): n = 0sur la valeur de n qui est égale à 180 alors que :
For i = 2 To UBound(aa)UBound(aa) retourne 389 donc, à partir de 181 erreur !
mieux vaut utiliser :
n = n + 1: ReDim Preserve réf(1 To n)
réf(n) = WorksheetFunction.Index(aa, i, 0)Ensuite, ceci ne retourne rien car la fonction n'admet pas 0 sur le numéro de colonne :
WorksheetFunction.Index(aa, i, 0)Bonjour et merci @Theze pour ton aide.
J'ai essayé avec tes lignes, mais toujours la même erreur au même endroit
Voici le fichier tel que je l'ai modifié.
Une idée de ce qui cloche?
Merci
Oui, mais il te faut supprimer cette ligne de code :
ReDim réf(n): n = 0et ensuite, en ce qui concerne cette ligne :
réf(0) = WorksheetFunction.Index(aa, 1, 0)la dimension 0 n'existe pas avec le code que je t'ai donné puisque la base est 1 (n = n + 1 avant l'affectation de la valeur) donc c'est soit :
ReDim Preserve réf(0 To n)
réf(n) = WorksheetFunction.Index(aa, i, 0)
n = n + 1redimensionnement +1 par la suite afin de commecer à 0, soit :
réf(1) = WorksheetFunction.Index(aa, 1, 0)Je ne sais pas trop ce que tu veux réaliser mais si tu l'expliques de façon claire, on peut t'aider à arriver à tes fins car là, je ne vois pas trop !
Bonjour,
Le but est de dupliquer les lignes ayant plusieurs quantités et d'incrémenter (#00?) la référence. Voir exemple ci-dessous.
Merci pour votre aide
Bonjour,
Une piste pour commencer !
En ce qui concerne les codes colonne B, je ne sais pas où tu les trouves donc, à adapter car j'ai juste créé un code bidon :
Sub Test()
Dim FeAR As Worksheet
Dim FeLE As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim I As Integer
Dim J As Long
Set FeAR = Worksheets("Analyse de risque (2)")
On Error Resume Next
Set FeLE = Worksheets("Liste étiquettes 2")
If Err.Number <> 0 Then
Set FeLE = Worksheets.Add(, Sheets(Sheets.Count))
FeLE.Name = "Liste étiquettes 2"
End If
On Error GoTo 0
FeLE.Cells.Clear
With FeAR: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
For Each Cel In Plage
With FeLE
For I = 1 To Cel.Value
J = J + 1
.Range(.Cells(J, 1), .Cells(J, 6)).Value = FeAR.Range(FeAR.Cells(Cel.Row, 1), FeAR.Cells(Cel.Row, 6)).Value
.Cells(J, 2).Value = "005 002 001 #" & Format(I, "000")
Next I
End With
Next Cel
End SubBonjour Theze,
Je reviens sur le sujet quelques temps après ta réponse (vacances obligent
Les codes colonne B provienne de mon ERP. Ce sont les références de chaque pièces.
Dans ton code, par quoi il faudrait remplacer "005 002 001 #" pour que la macro scan toutes les lignes?
Merci
Bonjour,
Testes ce code pour voir si ça convient. Les codes sont récupérés dans la colonne B de la feuille "Analyse de risque (2)"
Voir "Cel.Offset(, 1).Value" dans la ligne de code ".Cells(J, 2).Value = Cel.Offset(, 1).Value & Format(I, "000")" :
Sub Test()
Dim FeAR As Worksheet
Dim FeLE As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim I As Integer
Dim J As Long
Set FeAR = Worksheets("Analyse de risque (2)")
On Error Resume Next
Set FeLE = Worksheets("Liste étiquettes 2")
If Err.Number <> 0 Then
Set FeLE = Worksheets.Add(, Sheets(Sheets.Count))
FeLE.Name = "Liste étiquettes 2"
End If
On Error GoTo 0
FeLE.Cells.Clear
With FeAR: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
For Each Cel In Plage
With FeLE
For I = 1 To Cel.Value
J = J + 1
.Range(.Cells(J, 1), .Cells(J, 6)).Value = FeAR.Range(FeAR.Cells(Cel.Row, 1), FeAR.Cells(Cel.Row, 6)).Value
'ici, le préfixe du code est récupéré dans la colonne B de la feuille "Analyse de risque (2)" --> Cel.Offset(, 1).Value
.Cells(J, 2).Value = Cel.Offset(, 1).Value & Format(I, "000")
Next I
End With
Next Cel
End Sub