Code VBA +Excel .. ne marche pas
Bonjour,
bonjour tout le monde mon problème est le suivant : j'ai deux feuilles dans un même classeur je cherche à parcourir les deux feuilles jusqu'à trouver correspondance
entre deux cellules de la première feuilles et deux autre de la deuxième feuilles merci d avance
voilà mon code
Sub rent_2()
Dim j As Long
Dim i As Double
'Worksheets("feuil1").Activate
'Selection.CurrentRegion.Select
For i = 2 To 107489
'Worksheets("feuil2").Activate
'Selection.CurrentRegion.Select
j = 2
While j <= 410
If Worksheets("Feuil2").Cells(j, 1).Value = Worksheets("Feuil1").Cells(i, 4).Value And Worksheets("Feuil2").Cells(j, 3).Value = Worksheets("Feuil1").Cells(i, 1).Value And Worksheets("Feuil2").Cells(j, 4).Value = "dividende" Then
Worksheets("Feuil1").Cells(i, 6).Value = Worksheets("Feuil1").Cells(i, 5).Value + (Worksheets("Feuil2").Cells(j, 2).Value / Worksheets("Feuil1").Cells(i + 1, 2).Value)
j = j + 1
Else
j = j + 1
End If
Wend
'Worksheets("feuil1").Activate
If Worksheets("Feuil1").Cells(i, 6).Text = "" Then
Worksheets("Feuil1").Cells(i, 6).Value = Worksheets("Feuil1").Cells(i, 5).Value
End If
Next i
End Sub
Dommage .. ça ne marche pas .. Est que quelqu ' un peut corriger mon Code et merci d avance.
bonjour tout le monde mon problème est le suivant : j'ai deux feuilles dans un même classeur je cherche à parcourir les deux feuilles jusqu'à trouver correspondance
entre deux cellules de la première feuilles et deux autre de la deuxième feuilles merci d avance
voilà mon code
Sub rent_2()
Dim j As Long
Dim i As Double
'Worksheets("feuil1").Activate
'Selection.CurrentRegion.Select
For i = 2 To 107489
'Worksheets("feuil2").Activate
'Selection.CurrentRegion.Select
j = 2
While j <= 410
If Worksheets("Feuil2").Cells(j, 1).Value = Worksheets("Feuil1").Cells(i, 4).Value And Worksheets("Feuil2").Cells(j, 3).Value = Worksheets("Feuil1").Cells(i, 1).Value And Worksheets("Feuil2").Cells(j, 4).Value = "dividende" Then
Worksheets("Feuil1").Cells(i, 6).Value = Worksheets("Feuil1").Cells(i, 5).Value + (Worksheets("Feuil2").Cells(j, 2).Value / Worksheets("Feuil1").Cells(i + 1, 2).Value)
j = j + 1
Else
j = j + 1
End If
Wend
'Worksheets("feuil1").Activate
If Worksheets("Feuil1").Cells(i, 6).Text = "" Then
Worksheets("Feuil1").Cells(i, 6).Value = Worksheets("Feuil1").Cells(i, 5).Value
End If
Next i
End Sub
Dommage .. ça ne marche pas .. Est que quelqu ' un peut corriger mon Code et merci d avance.
2 réponses
-
ContributeurBonjour,
Dommage .. ça ne marche pas
Qu'est-ce qui ne marche pas ? La macro se lance mais n'exécute rien ? Tu as un message d'erreur ? Si oui lequel ?
Si ton fichier ne contient pas de données confidentielles, transmets-le ici via le site cjoint.com (fichier au format .xls).
Cordialement. -
ContributeurJe teste, il semble que la macro fonctionne. C'est juste qu'elle est très longue.
Tu as un for i qui fait 100 000 lignes, un While j qui en fait 410, donc ça fait 41 000 000 d'instructions à faire. C'est très long !!!
