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
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