Formule ROW traduction VBA

  • Initiateur de la discussion Initiateur de la discussion applemilk
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

applemilk

XLDnaute Nouveau
Bonjour à tous,

Après de nombreuses recherches je me heurte à un dernier problème.
J'ai réussi à traduire (avec l'aide de quelqu'un sur un autre forum) ma formule en code VBA mais une partie ne fonctionne pas.

Ma formule initiale est:
=INDEX(List!$A$2:$Q$1600,SUMPRODUCT((List!$A$2:$A$1600=$A15)*(List!$E$2:$E$1600=$F14)*(List!$F$2:$F$1600=$G14)*(List!$L$2:$L$1600=$B15),ROW(List!$H$2:$H$1600)-1),8)

et mon code est:
Code:
Sub copy()

Dim nbrow As Long
nbrow = Sheet1.Range("A65536").End(xlUp).row
For j = 2 To nbrow

Dim R0 As Range
Set R0 = Sheet1.Range("A2:Q2000")

Dim R1 As Range
Set R1 = Sheet1.Range("A2:A1600")

Dim R5 As Range
Set R5 = Sheet1.Range("E2:E1600")

Dim R6 As Range
Set R6 = Sheet1.Range("F2:F1600")

Dim R8 As Range
Set R8 = Sheet1.Range("H2:H1600")

Dim R12 As Range
Set R12 = Sheet1.Range("L2:L1600")

'Copy 2nd layer Name
If Sheet4.Cells(j, 5) = "" And Sheet4.Cells(j, 2) = "2" Then
   Sheet4.Cells(j, 5).Activate
   ActiveCell.Value = Evaluate("Index(" & R0.Address & "), (Sumproduct((" & R1.Address & " = ActiveCell.Offset(0, -4).Value) * (" & R5.Address & " = ActiveCell.Offset(-1, 1).Value) * (" & R6.Address & " = ActiveCell.Offset(-1, 2).Value) * (" & R12.Address & " = ActiveCell.Offset(0, -3).Value)),(row(" & R8.Address(-1, 0) & "))), (" & R8.Address & ")) ")

   End If
   
Next j
End Sub

Je me retrouve avec une erreur 2015 dans VBA et un #VALUE! dans ma cellule.
La personne qui m'a aidé, a trouvé un message d'erreur avec la fonction Evaluate(row), evaluate ne semble pas fonctionner avec row.

Est ce que quelqu'un a une idée ou en sait plus?

Merci d'avance

Ps: cette action correspond au bouton INSERT dans mon fichier TEST

Merci!
 

Pièces jointes

Re : Formule ROW traduction VBA

Salut applemilk et le forum
Pas sûr, car je n'ai lu le sujet qu'en diagonale, et l'anglais et moi, on a divorcé il y a quelques temps 😉
Ma formule initiale est:
=INDEX(List!$A$2:$Q$1600,SUMPRODUCT((List!$A$2:$A$1600=$A15)*(List!$E$2:$E$1600=$F14)*(List!$F$2:$F$1600=$G14)*(List!$L$2:$L$1600=$B15),ROW(List!$H$2:$H$1600)-1),8)
en français, la partie en rouge donnerait :
Ligne(List!$H$2:$H$1600)-1 => Et ça devrait donner... une erreur (2-1=1)
Comme je n'ai pas envie de décortiquer la formule et que je n'en ai pas le temps, regarde l'aide pour voir les différences entre Row et Rows (ligne et lignes). Mais, de toute façon, vu que ce sont des donnée figées, les remplacer par la valeur te donnera alors la bonne réponse
ROW(List!$H$2:$H$1600)-1) = 1
ROWS(List!$H$2:$H$1600)-1) = 1599
et sans risque d'erreur !
À moins que contrairement à tes dires, la formule ne donne pas ce qu'on attend.
Et je n'ai pas envie de me creuser la tête pour savoir ce qu'une formule fausse aurait du vouloir dire 😡
A+
A+
 
Re : Formule ROW traduction VBA

Bonjour et merci pour vos réponses,

J'ai essayé ma formule avec rows mais ça ne fonctionne pas (et c'est normal) parce que ROW intégré comme il est dans ma formule vient chercher la case de la ligne du dessus, d'où le -1.

Sur l'autre forum, il ne dit pas plus qu'hier, c'est à dire:
"Pour une raison que je ne m'explique pas, chez moi EVALUATE semble ne pas fonctionner avec la formule ROW. J'ai pensé que c'était dû au fait que c'est une fonction volatile mais j'ai testé d'autre formule du même type et cela fonctionne. Même Rows fonctionne.
Je suis peut-être très fatigué et quelqu'un d'autres aura une explication.
Voici le code testé"

Code:
  Dim R As String: R = "A5"
 Dim R0 As String: R0 = "A2:Q2000"
 Dim R1 As String: R1 = "A2:A2000"
 Dim R5 As String: R5 = "E2:E2000"
 Dim R6 As String: R6 = "F2:F2000"
 Dim R8 As String:  R8 = "H2:H2000"
 Dim R12 As String: R12 = "L2:L2000"
 formule = "Index(" & R0 & ", 1, 3)"
 Debug.Print formule & vbTab & Evaluate(formule)
 formule = "ROWS(" & R8 & ")"
 Debug.Print formule & vbTab & Evaluate(formule)
 formule = "OFFSET(" & R & ", 1,1)"
 Debug.Print formule & vbTab & Evaluate(formule)
 formule = "ROW(" & R8 & ")"
 Debug.Print formule & vbTab & Evaluate(formule)

Pour ma part, je n'ai pas réussi à trouver de solution de ce côté et ai donc essayé d'une autre façon qui ne fonctionne toujours pas mais qui sera peut être plus facile à résoudre.

C'est assez simple en fait, j'ai deux feuilles avec des données identiques mais pas dans le même ordre et je cherche à copier une cellule de la feuil1 vers la feuil2 si 4 des cellules de la ligne sont identiques.

Le problème avec mon code là, c'est que VBA compare toujours les mêmes lignes entre elles (feuil1 ligne21 avec feuil2 ligne 21) alors que la ligne 21 de ma feuil1 est peut etre égale à la ligne 25 de ma feuil2, c'est variable.

Ca ne marche ni comme ça:
Code:
Sub insert()
Dim nbrow As Long
nbrow = Sheet1.Range("A65536").End(xlUp).Row
For j = 2 To nbrow

Dim R0 As Range
Set R0 = Sheet1.Range("A2:Q2000")

Dim R1 As Range
Set R1 = Sheet1.Range("A2:A1600")

Dim R5 As Range
Set R5 = Sheet1.Range("E2:E1600")

Dim R6 As Range
Set R6 = Sheet1.Range("F2:F1600")

Dim R8 As Range
Set R8 = Sheet1.Range("H2:H1600")

Dim R12 As Range
Set R12 = Sheet1.Range("L2:L1600")


'Copy 2nd layer Name
If Sheet4.Cells(j, 5) = "" And Sheet4.Cells(j, 2) = "2" Then
   Sheet4.Cells(j, 5).Activate
   
If R1.Address = ActiveCell.Offset(0, -4).Value And R12.Address = ActiveCell.Offset(0, -3).Value And R5.Address = ActiveCell.Offset(-1, 1).Value And R6.Address = ActiveCell.Offset(-1, 2).Value Then
ActiveCell.Value = R8.Address

End If
End If
Next j
End Sub

Ni comme ça:
Code:
If sheet1.cells(j,1) = ActiveCell.Offset(0, -4).Value And sheet1.cells(j,12)= ActiveCell.Offset(0, -3).Value And sheet1.cells(j,5)= ActiveCell.Offset(-1, 1).Value And sheet1.cells(j,6) = ActiveCell.Offset(-1, 2).Value Then
ActiveCell.Value = sheet1.cells(j,8)

Des idées??

Merci d'avance!
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
580
Réponses
5
Affichages
703
Réponses
10
Affichages
531
Réponses
10
Affichages
843
  • Question Question
Microsoft 365 Code VBA
Réponses
10
Affichages
904
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
805
Réponses
3
Affichages
834
  • Question Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
868
Retour