Transform Colonnes en 1 Tableau en VBA

[xvella]

Bonsoir Tous,
Bonsoir Forum,

Voilà mon souci j'ai après filtration en VBA 2 Colonnes : Date / Donnée

J'aimerais pouvoir transformer celles-ci en un seul tableau pour effectuer la moyenne, l'ecart type, le mini et le maxi par jours.

Merci d'avance pour vos réponce.

A+

 

[ROGER2327]

Re : Transform Colonnes en 1 Tableau en VBA

Bonsoir xvella

Une proposition dans le classeur joint.

[COLOR="DarkSlateGray"]Sub recap()
Dim i As Long, j As Long, k As Long, l As Long, d
Dim oDat(), oDd()
   With Sheets("Donnée_Reçu")
      oDat = .Range("B2", .Range("B2").End(xlDown).Offset(0, 1)).Value
   End With
   ReDim oDd(1 To 1)
   oDd(1) = oDat(2, 1)
   For i = 3 To UBound(oDat, 1)
      d = oDat(i, 1)
      For j = 1 To UBound(oDd)
         If oDd(j) = d Then Exit For
      Next j
      If j > UBound(oDd) Then
         ReDim Preserve oDd(1 To UBound(oDd) + 1)
         oDd(UBound(oDd)) = d
      End If
   Next i
   For j = 1 To UBound(oDd)
      k = 0
      For i = 2 To UBound(oDat, 1)
         If oDd(j) = oDat(i, 1) And Not IsEmpty(oDat(i, 2)) Then k = k + 1
      Next i
      l = Application.Max(l, k)
   Next j
   ReDim oDd(1 To l + 1, 1 To UBound(oDd))
   For i = 2 To UBound(oDat, 1)
      d = oDat(i, 1)
      For j = 1 To UBound(oDd, 2)
         If oDd(1, j) = d Or IsEmpty(oDd(1, j)) Then
            oDd(1, j) = oDat(i, 1)
            For k = 1 To UBound(oDd, 1)
               If IsEmpty(oDd(k, j)) Then oDd(k, j) = oDat(i, 2): Exit For
            Next k
            Exit For
         End If
      Next j
   Next i
   Application.ScreenUpdating = False
   With Sheets("Recap")
      .Activate
      With .Range("B1")
         Range(.Offset(0, -1), .Offset(0, -1).SpecialCells(xlLastCell)).Clear
         .Resize(UBound(oDd, 1), UBound(oDd, 2)).Value = oDd
         .Offset(UBound(oDd, 1), -1).Value = "Moyenne"
         .Offset(UBound(oDd, 1), 0).Resize(1, UBound(oDd, 2)).FormulaR1C1 = "=AVERAGE(R[-" & UBound(oDd, 1) - 1 & "]C:R[-1]C)"
         .Offset(UBound(oDd, 1) + 1, -1).Value = "Ec. Type"
         .Offset(UBound(oDd, 1) + 1, 0).Resize(1, UBound(oDd, 2)).FormulaR1C1 = "=STDEV(R[-" & UBound(oDd, 1) & "]C:R[-2]C)"
         .Offset(UBound(oDd, 1) + 2, -1).Value = "Minimum"
         .Offset(UBound(oDd, 1) + 2, 0).Resize(1, UBound(oDd, 2)).FormulaR1C1 = "=MIN(R[-" & UBound(oDd, 1) + 1 & "]C:R[-3]C)"
         .Offset(UBound(oDd, 1) + 3, -1).Value = "Maximum"
         .Offset(UBound(oDd, 1) + 3, 0).Resize(1, UBound(oDd, 2)).FormulaR1C1 = "=MAX(R[-" & UBound(oDd, 1) + 2 & "]C:R[-4]C)"
         With Union(.Resize(UBound(oDd, 1), UBound(oDd, 2)), .Offset(UBound(oDd, 1), -1).Resize(4, UBound(oDd, 2) + 1))
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            With .Borders(xlEdgeLeft)
               .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
            End With
            With .Borders(xlEdgeTop)
               .LineStyle = xlContinuous
               .Weight = xlThin
               .ColorIndex = xlAutomatic
            End With
            With .Borders(xlEdgeBottom)
               .LineStyle = xlContinuous
               .Weight = xlThin
               .ColorIndex = xlAutomatic
            End With
            With .Borders(xlEdgeRight)
               .LineStyle = xlContinuous
               .Weight = xlThin
               .ColorIndex = xlAutomatic
            End With
            With .Borders(xlInsideVertical)
               .LineStyle = xlContinuous
               .Weight = xlThin
               .ColorIndex = xlAutomatic
            End With
            With .Borders(xlInsideHorizontal)
               .LineStyle = xlContinuous
               .Weight = xlThin
               .ColorIndex = xlAutomatic
            End With
         End With
      End With
   End With
   Application.ScreenUpdating = True
End Sub[/COLOR]

ROGER2327

 

[soenda]

Re : Transform Colonnes en 1 Tableau en VBA

Bonsoir le fil, xvella, Roger2327

Pour le dernier bloc With Union(...

    With Union(.Resize(UBound(oDd, 1), . . .
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
   End With

Semble suffisant

A plus

 

[ROGER2327]

Re : Transform Colonnes en 1 Tableau en VBA

Re...

Bonsoir le fil, xvella, Roger2327

Pour le dernier bloc With Union(...

    With Union(.Resize(UBound(oDd, 1), . . .
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
   End With

Semble suffisant

A plus

Parfaitement exact. Il y a quelques autres lignes qui ne sont pas réellement indispensables. Mais je les ai mises pour permettre de modifier rapidement le formatage, sans réécrire intégralement ces lignes.
​

ROGER2327

 

[xvella]

Re : Transform Colonnes en 1 Tableau en VBA

Bonjour Roger2327,Bonjour soenda
Bonjour Forum

Un grand merci à tous les deux, ça marche sans problème et surtout c'est beaucoup plus que ce que je demandais.

Grace à vous j'ai gagné un temps prodigieux.

Encore Merci.

@+