comparaison chaque cellule sur 2 lignes

Question

Bonjour,

N'ayant pas assez de connaissances en VBA...

Existe-t-il un code qui me permettrait :
1/ comparer chaque cellule de deux lignes n et n-1 pour un tableau range ("A1:T5204")
	
'(exemple ligne n-1 et ligne n)
'ligne 5203=n-1 / 7 8  12 18 23 24 28 30 31 34 36 37 41 47 49 52 54 58 63 70
'ligne 5204=n   / 4 11 12 14 23 25 26 35 36 37 41 51 54 56 58 59 63 66 68 69

	la cellule base (en ligne n) ne sera comparée qu'au nombre de cellule = sa_valeur
       ' exemple "4" en ligne n ne sera comparé qu'à 7 8 12 et 18 en ligne n-1
	'exemple "11" en ligne n ne sera comparé qu'au 11 premières cellules de la ligne n-1
	Si sa_valeur>=20 alors comparer sur l'ensemble de la ligne n-1

Si sa_valeur trouvée en ligne n-1 & Si au moins colonne AA & ligne n = valeur"A" à "T" 

	'exemple 12, 23, 36, 37, 41, 54, 58, 63 sont présents dans les deux lignes

alors inscription dans 
colonne V  & ligne n: "C"
colonne W  & ligne n: "E"
colonne X  & ligne n: "I"
colonne Y  & ligne n: "J"
colonne Z  & ligne n: "K"
colonne AA & ligne n: "M"
colonne AB & ligne n: "O"
colonne AC & ligne n: "Q"
colonne AD & ligne n: ""
colonne AE & ligne n: ""

Passer aux deux lignes suivantes (ligne n = 5203 et ligne n-1 = 5202)

Loop 'jusqu'à ligne 1 et ligne 2 fin d'exécution macro

Merci

cousinhub29 · Answer

Bonjour,

Un essai :

Sub prog()
Dim Tblo, Tblo2
Dim TbloF()
Dim I As Long, DerLig As Long
Dim J As Byte, K As Byte
Dim Col
Columns("V:AO").ClearContents
DerLig = Cells(Rows.Count, 1).End(xlUp).Row
ReDim TbloF(1 To DerLig, 1 To 20)
Tblo = Range("A1:T" & DerLig).Value
For I = UBound(Tblo) - 1 To LBound(Tblo) Step -1
    K = 1
    Tblo2 = Application.Transpose(Application.Transpose(Cells(I + 1, 1).Resize(1, 20)))
    For J = 1 To 20
    Col = Application.Match(Tblo(I, J), Tblo2, 0)
    If Not IsError(Col) Then
        If Col <= Tblo(I, J) Then
            TbloF(I + 1, K) = Chr(Col + 64): K = K + 1
        End If
    End If
    Next J
Next I
Range("V1").Resize(DerLig, 20).Value = TbloF
End Sub


Bon courage

ptitepuce07 · Answer

Merci beaucoup
C'est excellent et ça répond entièrement à mes attentes

Comparaison chaque cellule sur 2 lignes

2 réponses

Discussions similaires

Newsletters