XL 2010 Faire le lettrage

Annick3

XLDnaute Nouveau
Je voudrais faire le lettrage Je cherche une méthode comment rapprocher les montant de deux colonnes
 

dg62

XLDnaute Barbatruc
Bonjour Annick3, le forum
une procédure un peu longue actuellement à l’exécution mais qui peut-être optimisée si cela correspond à votre besoin.
VB:
Sub lettrage()
Application.ScreenUpdating = False
Dim derlig As Long

   With Worksheets("Autres fournisseurs")
    
       derlig = .Range("a" & Rows.Count).End(xlUp).Row
       .Range("E2:E" & derlig).ClearContents
    
       For i = 2 To derlig
                        
           For j = i + 1 To derlig    '
               If .Cells(i, 5) = "" And .Cells(i, 6) > 0 Then
                 If .Cells(i, 3) = .Cells(j, 3) And .Cells(i, 6) = .Cells(j, 7) Then
                   .Cells(i, 5) = "A"
                   .Cells(j, 5) = "A"
                 End If
               End If
            Next j
        Next i

    End With
Application.ScreenUpdating = True

End Sub

petite modification du code pour éviter les valeurs nulles.
 
Dernière édition:

dg62

XLDnaute Barbatruc
re,
version optimisée, lettrage effectué le temps d'appuyer sur le bouton ):
le code pour ceux qui ne souhaitent pas ouvrier le fichier.

VB:
Sub lettrage2()
Dim journal As Variant
Dim derlig As Long
' Dernière ligne du journal
derlig = Worksheets("Autres fournisseurs").Range("a" & Rows.Count).End(xlUp).Row
' Effacement du contenu de la colonne lettre
Range("E2:E" & derlig).ClearContents
' Affectation du contenu de la feuille au tableau journal
journal = Worksheets("Autres fournisseurs").Range("A2:H" & derlig).Value
' lettrage des écritures sans correspondance avec les libellés.
' correspondance des montants uniquement
For i = 1 To UBound(journal)
                         
           For j = i + 1 To UBound(journal)    '
               If journal(i, 5) = "" And journal(i, 6) > 0 Then
                 If journal(i, 6) = journal(j, 7) Then
                   journal(i, 5) = "A" & i
                   journal(j, 5) = "A" & i
                 End If
               End If
            Next j
        Next i
' Affichage du journal traité
Worksheets("Autres fournisseurs").Range("A2:H" & derlig).Value = journal
End Sub
 

Pièces jointes

  • AUTRES FOURNISSEURS (2).xlsm
    102.7 KB · Affichages: 15
Dernière édition:

Discussions similaires

Réponses
8
Affichages
400
Réponses
17
Affichages
666

Statistiques des forums

Discussions
312 294
Messages
2 086 895
Membres
103 404
dernier inscrit
sultan87