Boucle verticale et horizontale?

Bonjour à tous,

Je recherche un moyen vba qui me permettrais de comptabiliser par mois le nombre même cas traiter.

J'utilise déjà cette méthode par le biais de tableaux croisés dynamiques mais ce n'est pas très très pratique quand il s'agit d'aller récupérer les données (je procède avec un Vlookup) et dès qu'une valeur vient s'ajouter tout se décale

Pensez-vous être en mesure de m'aider?

Voir fichier joint:

3 onglets:

Vertical: ==> Recherche dans un tableau où les valeurs sont verticales

Horizontal: ==> Recherche dans un tableau où les valeurs sont horizontales

Résultat souhaité:

Un très grand merci d'avance

kwld

Up

Salut Kwld,

voici un premier jet de ton fichier, à tester grandeur nature.

Je n'ai, ici, pas cherché à vérifier le nombre de références Lettres.

'
Dim tTab
Dim tTabF(10, 12) As Integer
'
For x = 1 To 2
    sFlag = Choose(x, "Vertical", "Horizontal")
    With Worksheets(sFlag)
        iFlag1 = Choose(x, .Cells(Rows.Count, 1).End(xlUp).Row - 1, 2)
        iFlag2 = Choose(x, 2, .Cells(1, Columns.Count).End(xlToLeft).Column - 1)
        sFlag = Choose(x, "A2", "B1")
        tTab = .Range(sFlag).Resize(iFlag1, iFlag2)
    End With
    iFlag3 = IIf(x = 1, 1, 2)
    For y = 1 To UBound(tTab, iFlag3)
        If x = 1 Then
            iCol = Month(CDate(tTab(y, 2)))
            sLib = tTab(y, 1)
        Else
            iCol = Month(CDate(tTab(2, y)))
            sLib = tTab(1, y)
        End If
        iRow = Switch(sLib = "A", 0, sLib = "B", 1, sLib = "C", 2, sLib = "D", 3, sLib = "E", 4, sLib = "F", 5, sLib = "G", 6, sLib = "M", 7, sLib = "Z", 8, sLib = "Y", 9)
        tTabF(iRow, iCol - 1) = tTabF(iRow, iCol - 1) + 1
    Next
Next
Worksheets("Recap").Range("B2:M11") = tTabF
'

A+

Bonjour,

Une proposition à étudier.

Pour des recherches éventuelles, pense à utiliser la fonction LIREDONNEESTABCROISDYNAMIQUE.

Cdlt.

Bonjour, Salut Curulis,

Autre méthode (à voir) :

Sub Récap()
    Dim TR(), d As Object, d0 As Object, k, nf, f%, n%, i%, j%, m%
    nf = Split("Vertical;Horizontal", ";")
    Set d = CreateObject("Scripting.Dictionary")
    Set d0 = CreateObject("Scripting.Dictionary")
    ReDim TR(2)
    For f = 0 To UBound(nf)
        With Worksheets(nf(f))
            TR(1) = .Cells(.Rows.Count, 1).End(xlUp).Row
            TR(2) = .Cells(1, .Columns.Count).End(xlToLeft).Column
            If TR(2) = 2 Then
                n = TR(1): TR(0) = True
            ElseIf TR(1) = 2 Then
                n = TR(2): TR(0) = False
            Else
                MsgBox "Présentation non conforme." & Chr(10) & "Abandon.", vbCritical, _
                 "Tableaux de données à revoir"
            End If
            For i = 2 To n
                k = IIf(TR(0), .Cells(i, 1), .Cells(1, i))
                If TR(0) Then m = Month(.Cells(i, 2)) Else m = Month(.Cells(2, i))
                d0(k) = "": k = k & Format(m, "00")
                If d.exists(k) Then
                    d(k) = CInt(d(k)) + 1
                Else
                    d(k) = 1
                End If
            Next i
        End With
    Next f
    ReDim TR(d0.Count, 12): n = 0
    For Each k In d0.keys
        n = n + 1: TR(n, 0) = k
    Next k
    For i = 1 To n - 1
        For j = i + 1 To n
            If TR(j, 0) < TR(i, 0) Then
                TR(0, 0) = TR(j, 0): TR(j, 0) = TR(i, 0): TR(i, 0) = TR(0, 0)
            End If
        Next j
    Next i
    TR(0, 0) = Empty
    For i = 1 To 12
        TR(0, i) = StrConv(MonthName(i), vbProperCase)
    Next i
    For i = 1 To n
        For j = 1 To 12
            k = TR(i, 0) & Format(j, "00")
            If d.exists(k) Then TR(i, j) = CInt(d(k))
        Next j
    Next i
    With ActiveSheet
        Application.ScreenUpdating = False
        .UsedRange.ClearContents
        .Range("A1").Resize(UBound(TR, 1) + 1, 13).Value = TR
    End With
End Sub

Seul adaptation éventuelle à opérer, la ligne : nf = Split("Vertical;Horizontal", ";")

Emplacement surligné : liste des feuilles à traiter, séparées par des ;

Les données à traiter devant être comme sur le modèle : si vertical col. A et B à partir ligne 2, si horizontal ligne1 et 2 à partir col. B.

Les noms sont triés par ordre alpha dans le tableau récap.

Cordialement.

Bonjour

Je m'empresse de tester ça et revient avec mes questions si il y en a

un grand merci

kwld