augmenter 1/4 2/4 3/4 Fermé

Question

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

via55 · Answer

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

redaiwa · Answer

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ésFor l = 1 To 100  Range("E" & l + 1) = "" 'vider la colonne ENext lFor 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 IfNext lignelivre1End Sub
Voir fichier exemple : https://www.cjoint.com/c/EDxoXxPSrlD 

J'espère t'avoir aidé. :)

Augmenter 1/4 2/4 3/4

2 réponses

Discussions similaires