bonjour le forum
j'ai une erreur 1004,comme je n'y connais pas grand chose j'ai mis le code ci-dessous,l'erreur ce trouve a cette ligne:
"With .Resize(UBound(oCpt, 1), UBound(oCpt, 2))"
si quelqu'un peut m'aider.
merci
Sub ecart()
Dim pDat As Object, oCel As Range
Dim oVar As New Collection
Dim oCpt, i As Long, j As Long, k As Long, n As Long, tf As Boolean
Set pDat = Range("DATA") 'Plage contenant les données.(B2:U600)
With Range("SORT") 'Première cellule de résultat. (W2)
.CurrentRegion.Offset(1, 0).ClearContents
Application.ScreenUpdating = False
On Error Resume Next
For Each oCel In pDat.Cells
oVar.Add oCel.Value, CStr(oCel.Value)
Next oCel
On Error GoTo 0
ReDim oCpt(1 To oVar.Count, 1 To 2) As Variant
For i = 1 To oVar.Count
oCpt(i, 1) = oVar(i)
n = 0
For j = 1 To pDat.Rows.Count
tf = False
For k = 1 To pDat.Columns.Count
If pDat.Cells(j, k).Value = oVar(i) Then
tf = True
n = n + 1
Exit For
End If
Next k
If Not tf Or j = pDat.Rows.Count Then
If n > 1 Then
If n > UBound(oCpt, 2) Then ReDim Preserve oCpt(1 To oVar.Count, 1 To n)
oCpt(i, n) = oCpt(i, n) + 1
End If
tf = False
n = 0
End If
Next j
Next i
Set oVar = Nothing
With .Resize(UBound(oCpt, 1), UBound(oCpt, 2))'l'erreur est a cette ligne
.Value = oCpt
.Sort Key1:=Range("SORT"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
Application.ScreenUpdating = True
End With
End Sub
j'ai une erreur 1004,comme je n'y connais pas grand chose j'ai mis le code ci-dessous,l'erreur ce trouve a cette ligne:
"With .Resize(UBound(oCpt, 1), UBound(oCpt, 2))"
si quelqu'un peut m'aider.
merci
Sub ecart()
Dim pDat As Object, oCel As Range
Dim oVar As New Collection
Dim oCpt, i As Long, j As Long, k As Long, n As Long, tf As Boolean
Set pDat = Range("DATA") 'Plage contenant les données.(B2:U600)
With Range("SORT") 'Première cellule de résultat. (W2)
.CurrentRegion.Offset(1, 0).ClearContents
Application.ScreenUpdating = False
On Error Resume Next
For Each oCel In pDat.Cells
oVar.Add oCel.Value, CStr(oCel.Value)
Next oCel
On Error GoTo 0
ReDim oCpt(1 To oVar.Count, 1 To 2) As Variant
For i = 1 To oVar.Count
oCpt(i, 1) = oVar(i)
n = 0
For j = 1 To pDat.Rows.Count
tf = False
For k = 1 To pDat.Columns.Count
If pDat.Cells(j, k).Value = oVar(i) Then
tf = True
n = n + 1
Exit For
End If
Next k
If Not tf Or j = pDat.Rows.Count Then
If n > 1 Then
If n > UBound(oCpt, 2) Then ReDim Preserve oCpt(1 To oVar.Count, 1 To n)
oCpt(i, n) = oCpt(i, n) + 1
End If
tf = False
n = 0
End If
Next j
Next i
Set oVar = Nothing
With .Resize(UBound(oCpt, 1), UBound(oCpt, 2))'l'erreur est a cette ligne
.Value = oCpt
.Sort Key1:=Range("SORT"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
Application.ScreenUpdating = True
End With
End Sub
