une balance agée avec VBA

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

emilieyang

XLDnaute Nouveau
bonjour,
je souhait de créer une balance agée avec VBA. Voici mon programme écrit, malheusement, il ne marche pas.
je vous remercie en avance.


Sub AddColmnValuetosheet2()

Dim numrows As Integer
Dim numcolumns As Integer

Feuil1.Activate
numrows = Feuil1.UsedRange.Rows.Count

numcolumns = Feuil1.UsedRange.Columns.Count


Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer


For i = 1 To numcolumns

If Feuil1.Cells(1, i).Value = "¨¦l¨¦ment 1" Then
Exit For
End If
Next i
Feuil1.Range(Cells(2, i), Cells(numrows, i)).Select
Selection.Copy
Feuil2.Select
Feuil2.Range("A2").Select
Feuil2.Paste
Feuil1.Activate
For j = 1 To numcolumns
If Feuil1.Cells(1, j).Value = "R¨¦f¨¦rence crois¨¦e" Then
Exit For
End If
Next j
Feuil1.Range(Cells(2, j), Cells(numrows, j)).Select
Selection.Copy
Feuil2.Select
Feuil2.Range("B2").Select
Feuil2.Paste
Feuil1.Activate
For k = 1 To numcolumns
If Feuil1.Cells(1, k).Value = "date doc" Then
Exit For
End If
Next k
Feuil1.Range(Cells(2, k), Cells(numrows, k)).Select
Selection.Copy
Feuil2.Select
Feuil2.Range("C2").Select
Feuil2.Paste
Feuil1.Activate
For l = 1 To numcolumns
If Feuil1.Cells(1, l).Value = "valeur" Then
Exit For
End If
Next l
Feuil1.Range(Cells(2, l), Cells(numrows, l)).Select
Selection.Copy
Feuil2.Select
Feuil2.Range("D2").Select
Feuil2.Paste



Feuil2.Range("$E$2", Cells(numrows, 5)).Formula = "=Feuil3!$F$3"
Feuil2.Range("$F$2", Cells(numrows, 6)).Formula = "=days360(Feuil2!C2,Feuil2!E2,true)"
Feuil2.Range("$G$2", Cells(numrows, 7)).Formula = "=LOOKUP(Feuil2!F2,{0,30,60,90,120,150,180,365},{1,2,3,4,5,6,7,8})"





'copie des references non repetee

Feuil2.Cells(1, 9).Value = "400"
Feuil2.Cells(1, 18).Value = "4001"


Dim strSheetName As String, strColumnLetter As String

strSheetName = "feuil2" ' ɾ³ý¹¤×÷±íÖеÄÖØ¸´ÐÐ
strColumnLetter = "B" ' ÒÔ B ÁÐÖеÄÖØ¸´Ïî×÷Ϊɾ³ýÌõ¼þ

Dim strColumnRange As String
Dim rngCurrentCell As Range
Dim rngNextCell As Range

strColumnRange = strColumnLetter & "2"

Feuil2.Range(strColumnRange).Sort _
Key1:=Feuil2.Range(strColumnRange)

Set rngCurrentCell = Feuil2.Range(strColumnRange)
m = 2
For x = 2 To numrows
Set rngNextCell = rngCurrentCell.Offset(1, 0)
If rngNextCell.Value <> rngCurrentCell.Value Then
Feuil2.Cells(m, 9).Value = rngCurrentCell.Value
m = m + 1
End If
Set rngCurrentCell = rngNextCell
Next x


Feuil2.Cells(1, 9).Value = "400"
Feuil2.Cells(m, 8).Value = "4001"

Dim a As Integer
a = m

For n = 2 To numrows

If Feuil2.Cells(n, 1).Value = "499601" Then
a = a + 1
Feuil2.Cells(a, 8).Value = Feuil2.Cells(n, 2).Value
Else: End If
Next n
' Feuil2.Range("$J$2", Cells(numrows, 10)).Formula = "=SUMPRODUCT((Feuil2!A:A=499600)*(Feuil2!B:B=Feuil2!$I2)*(Feuil2!G:G=1),(D😀))"
' Feuil2.Range("$K$2", Cells(numrows, 11)).Formula = "=Feuil2!$F$3"
' Feuil2.Range("$L$2", Cells(numrows, 12)).Formula = "=Feuil2!$F$3"
' Feuil2.Range("$M$2", Cells(numrows, 13)).Formula = "=Feuil2!$F$3"
' Feuil2.Range("$N$2", Cells(numrows, 14)).Formula = "=Feuil2!$F$3"
' Feuil2.Range("$O$2", Cells(numrows, 15)).Formula = "=Feuil2!$F$3"
' Feuil2.Range("$P$2", Cells(numrows, 16)).Formula = "=Feuil2!$F$3"
'Feuil2.Range("$Q$2", Cells(numrows, 17)).Formula = "=Feuil2!$F$3"
'Feuil2.Range("$R$2", Cells(numrows, 18)).Formula = "=Feuil2!$F$3"
End Sub
 

Pièces jointes

Re : une balance agée avec VBA

Hello,

Voici une solution. J'ai bien aimé ta question en tout cas, très sympa à faire 😛

Je suis parti sur tout autre chose par rapport à ton fichier, j'ai utilisé sommeprod.

Les formules sont à descendre comme tu le souhaites

@ +

Juju
 

Pièces jointes

Re : une balance agée avec VBA

bonjour,
j'ai testé le programme en mes données réelles,🙁 mais je ne comprends pas pourquoi il ne marche pas .

remercie à nouveau
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
177
Réponses
8
Affichages
233
Réponses
1
Affichages
180
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
169
Réponses
2
Affichages
201
Réponses
8
Affichages
466
Retour