Sub position() Dim i As Long Dim j As Long Dim fin_sh2 As Long Dim fin_sh3 As Long fin_sh2 = Sheets(2).Range("C" & Rows.Count).end(xlUp).Row fin_sh3 = Sheets(3).Range("A" & Rows.Count).end(xlUp).Row With Sheets(2) For i = 2 To fin_sh2 For j = 2 To fin_sh3 If .Cells(i, 3).Value = Sheets(3).Cells(j, 1).Value Then If .Cells(i, 6).Value >= Sheets(3).Cells(j, 2).Value Then If .Cells(i, 6).Value <= Sheets(3).Cells(j, 3).Value Then .Cells(i, 7).Value = "couche" Else .Cells(i, 7).Value = "debout" End If End If End If Next j Next i End With End Sub
derlig2 = Sheets("Feuil2").Range("C" & Rows.Count).End(xlUp).Row derlig3 = Sheets("Feuil3").Range("A" & Rows.Count).End(xlUp).Row tablo2 = Sheets("Feuil2").Range("A2:G" & derlig2) tablo3 = Sheets("Feuil3").Range("A2:C" & derlig2) For i = 1 To UBound(tablo2) For j = 1 To UBound(tablo3) If tablo2(i, 3) = tablo3(j, 1) Then If tablo2(i, 6) >= tablo3(j, 2) Then If tablo2(i, 6) <= tablo3(j, 3) Then tablo2(i, 7) = "couche" Else tablo2(i, 7) = "debout" End If End If End If Next Next Sheets("Feuil2").Range("A2:G" & derlig2) = tablo2
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionSub position() For i = 2 To Sheets(2).Range("C" & Rows.Count).End(xlUp).Row For j = 2 To Sheets(3).Range("A" & Rows.Count).End(xlUp).Row If Sheets(2).Range("C" & i) = Sheets(3).Range("A" & j) Then If Sheets(2).Range("F" & i) >= Sheets(3).Range("B" & j) Then If Sheets(2).Range("F" & i) <= Sheets(3).Range("C" & j) Then Sheets(2).Range("G" & i) = "couche" Else: Sheets(2).Range("G" & i) = "debout" End If End If End If Next j Next i End Sub
fin_sh2 = Sheets(2).Range("C" & Rows.Count).End(xlUp).Row fin_sh2 = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row For i = 2 To fin_sh2 For j = 2 To fin_sh3
If Sheets(2).Range("C" & i).Value = Sheets(3).Range("A" & j).Value Then
If Sheets(2).Cells(i, 3).Value = Sheets(3).Cells(j ,1).Value Then
Sub position() Dim i As Long Dim j As Long Dim fin_sh2 As Long Dim fin_sh3 As Long fin_sh2 = Sheets(2).Range("C" & Rows.Count).end(xlUp).Row fin_sh3 = Sheets(3).Range("A" & Rows.Count).end(xlUp).Row Application.ScreenUpdating = False ' <<<<< ' le code... Application.ScreenUpdating = True ' <<<<< End Sub
Dim tablo(1 To 10, 1 To 3) ' 1) _______ juste pour créer un tableau exemple _____________ For i = 1 To 10 For j = 1 To 3 tablo(i, j) = "a" & i & j Next Next ' 2) _______________ on l'injecte ainsi Range("A1:C10") = tablo
Il n'empêche qu'au départ il faut bien renseigner le tableau en parcourant les cellules de la plage.
tablo = Range("A1:D5") ' le voilà, ton tableau ' on va le traiter (faire ici semblant en ajoutant "vu ?" à chaque élément For i = 1 To UBound(tablo, 1) For j = 1 To UBound(tablo, 2) tablo(i, j) = tablo(i, j) & "vu ?" Next Next Range("A1:D5").Value = tablo
Sub tabex() derniere_ligne = Sheets(2).Range("C1").End(xlDown).Row Dim tab_exa() ReDim tab_exa(derniere_ligne - 2, 2) Dim tab_exb(215, 2) For i = 2 To derniere_ligne - 2 tab_exa(i, 0) = Sheets(2).Range("C" & i + 2) tab_exa(i, 1) = Sheets(2).Range("F" & i + 2) tab_exa(i, 2) = Sheets(2).Range("G" & i + 2) Next i For j = 2 To UBound(tab_exb, 1) tab_exb(j, 0) = Sheets(3).Range("A" & j) tab_exb(j, 1) = Sheets(3).Range("B" & j) tab_exb(j, 2) = Sheets(3).Range("C" & j) Next j For i = 2 To UBound(tab_exa, 1) For j = 2 To UBound(tab_exb, 1) If tab_exa(i, 0) = tab_exb(j, 0) Then If tab_exa(i, 1) >= tab_exb(j, 1) And tab_exa(i, 1) <= tab_exb(j, 2) Then tab_exa(i, 2).Value = "couche" End If End If Next j Next i Range("G2:G" & [G65536].End(xlUp).Row).Value = tab_exa(i, 2) End Sub
For x = 1 to 2 ' on s'en moque next msgbox x ' ===>> x vaut alors 2 + 1 = 3 et non 2