Augmenter 1/4 2/4 3/4
j'ai reussi dans excel que si la ligne précédente à le même critère dans la colonne A ou D que ça les comptes et mette 1/le nombre d'exemplaire trouver
Maintenant j'aimerai que le premier chiffre corresponde ou 1 livre trouver le 2 au deuxième ainsi de suite.
Mon code est le suivant
Dim i As Integer
Dim nb As Byte
Dim calcul As Boolean
Dim longueur As Byte
Dim position As Byte
Dim a As String
Dim b As String
ActiveSheet.Unprotect (FGestion.Cells(16, 2))
FBaseLivre.Unprotect (FGestion.Cells(16, 2))
nb = 0
calcul = False
For i = 1 To 37 'On affiche tout les livres dans la base
FBaseLivre.ListObjects("Tableau3").Range.AutoFilter Field:=i
Next
For i = 2 To FBaseLivre.Cells(2, 1) + 1 'On parcour la base de donnée
' For i = 2 To FBaseLivre.Cells(1, 1) + 1 'On parcour la base de donnée
For j = 3 To FBaseLivre.Cells(2, 1) + 2 'On parcour la base de donnée
' For j = 3 To FBaseLivre.Cells(1, 1) + 2 'On parcour la base de donnée
If FBaseLivre.Cells(j, 3) = FBaseLivre.Cells(i, 3) And FBaseLivre.Cells(i, 2) = FBaseLivre.Cells(j, 2) Then 'Cote et titre
'On augmente le nombre de livre
longueur = Len(FBaseLivre.Cells(i, 36))
position = InStr(1, FBaseLivre.Cells(i, 36), "/") 'Recherche la position du "/"
a = Left(FBaseLivre.Cells(i, 36), position - 1)
b = Right(FBaseLivre.Cells(i, 36), longueur - position)
FBaseLivre.Cells(i, 36) = Right(Str(a), Len(Str(a)) - 1) + "/" + Right(Str(b + 1), Len(Str(b + 1)) - 1)
End If
Next
Next
merci de votre aide
Maintenant j'aimerai que le premier chiffre corresponde ou 1 livre trouver le 2 au deuxième ainsi de suite.
Mon code est le suivant
Dim i As Integer
Dim nb As Byte
Dim calcul As Boolean
Dim longueur As Byte
Dim position As Byte
Dim a As String
Dim b As String
ActiveSheet.Unprotect (FGestion.Cells(16, 2))
FBaseLivre.Unprotect (FGestion.Cells(16, 2))
nb = 0
calcul = False
For i = 1 To 37 'On affiche tout les livres dans la base
FBaseLivre.ListObjects("Tableau3").Range.AutoFilter Field:=i
Next
For i = 2 To FBaseLivre.Cells(2, 1) + 1 'On parcour la base de donnée
' For i = 2 To FBaseLivre.Cells(1, 1) + 1 'On parcour la base de donnée
For j = 3 To FBaseLivre.Cells(2, 1) + 2 'On parcour la base de donnée
' For j = 3 To FBaseLivre.Cells(1, 1) + 2 'On parcour la base de donnée
If FBaseLivre.Cells(j, 3) = FBaseLivre.Cells(i, 3) And FBaseLivre.Cells(i, 2) = FBaseLivre.Cells(j, 2) Then 'Cote et titre
'On augmente le nombre de livre
longueur = Len(FBaseLivre.Cells(i, 36))
position = InStr(1, FBaseLivre.Cells(i, 36), "/") 'Recherche la position du "/"
a = Left(FBaseLivre.Cells(i, 36), position - 1)
b = Right(FBaseLivre.Cells(i, 36), longueur - position)
FBaseLivre.Cells(i, 36) = Right(Str(a), Len(Str(a)) - 1) + "/" + Right(Str(b + 1), Len(Str(b + 1)) - 1)
End If
Next
Next
merci de votre aide
2 réponses
-
Bonsoir
Pas très compréhensible sans le fichier de départ ! et pourquoi passer par une macro alors qu'une simple formule suffirait peut-être
Postes un exemple d eton fichier sur cjoint.com et reviens ici indiquer le lien fourni
Cdlmnt
Via
-
Salam viret1290.
Je crois avoir compris ta demande et je te propose le code suivant :
Private Sub CompterLivresIdentiques_Click()
Dim livres(100) ' tableau pour stocker les lignes où se trouvent les livres identiques trouvés
For l = 1 To 100
Range("E" & l + 1) = "" 'vider la colonne E
Next l
For lignelivre1 = 2 To Range("A1").End(xlDown).Row 'parcourir tous les livres
For l = 1 To 100
livres(l) = 0 'vider le tableau
Next l
If Range("E" & lignelivre1) = "" Then 'si la colonne E n'est pas vide alors passer au livre suivant
nblivres = 1
livres(nblivres) = lignelivre1
For lignelivre2 = lignelivre1 + 1 To Range("A1").End(xlDown).Row 'parcourir les livres suivants
If Range("A" & lignelivre1) = Range("A" & lignelivre2) And Range("D" & lignelivre1) = Range("D" & lignelivre2) Then ' s'il y a correspondance
nblivres = nblivres + 1
livres(nblivres) = lignelivre2 'stocker la ligne du livre trouvé dans le tableau
End If
Next lignelivre2
For l = 1 To 100 ' parcourir les lignes stockées dans le tableau "livres"
If livres(l) <> 0 Then Range("E" & livres(l)) = l & "/" & nblivres 'inscrire en colonne E le nombre de livres trouvés
Next l
End If
Next lignelivre1
End Sub
Voir fichier exemple : https://www.cjoint.com/c/EDxoXxPSrlD
J'espère t'avoir aidé. :)
