XL 2010 VBA MArco pour regrouper des formules en une seule valeur

[jlbcall]

Bonjour,

J'ai un macro avec déja deux boucles et je souhaiterais en rajouter une 3 ème qui me permettrait de supprimer 3 colonnes Y ,Z et AA pour avoir au final le résultat de ma recherche en colonne X.
Le résultat en colonne X devra être une valeur et non plus un formule" RechercheV"
C'est boucle doit s'effectuer en fonction du nombre de valeur (dates) en colonne U.

Ci-joint un fichier en espérant avoir été le plus clair possible

Merci d'avance pour votre aide et belle journée à tous

 

[vgendron]

Bonsoir

il te suffit de rajouter ces deux lignes en fin de macro après tes boucle

FCAL.Range("X3").Resize(Date_fin - Date_début + 1) = FCAL.Range("X3").Resize(Date_fin - Date_début + 1).Value
FCAL.Range("Y:AA").Delete

 

[vgendron]

sinon.. pour le fun..
une macro qui n'a pas besoin de tes colonnes intermédiaires

elle travaille avec des tableaux vba et des dictionnaires;. normalement beaucoup plus rapide

Sub Affectation_Dates()
Dim tablo() As Variant 'le tableau final qui sera placé dans les colonnes U à X
Dim TabPériode() As Variant 'le tableau des colonnes M à O
Dim TabCodeExo() As Variant 'le tableau des colonne Q à S
Dim TabCodePériode() As Variant 'le tableau des colonnes C à J

Set DicoCodePériode = CreateObject("scripting.dictionary") 'dictionnaire qui permet d'associer les codes périodes à une valeur: SCO=1, PVS=2...
Set dicoJourFériés = CreateObject("scripting.dictionary") 'dictionnaire des Jours Fériés

With ActiveSheet 'dans la feuille active

    Date_Deb = .Range("M2") 'on récupère la date de début
    Date_fin = .Range("N2") 'celle de fin
    NbJours = Date_fin - Date_Deb + 1 'calcul du nombre de jours
    ReDim tablo(1 To NbJours, 1 To 4) 'on dimensionne le tableau sur NbJours lignes et 4 colonnes
   
    FinTabPériode = .Range("M" & .Rows.Count).End(xlUp).Row 'on récupère la dernière ligne de la colonne M
    TabPériode = .Range("M3:O" & FinTabPériode).Value 'on place le tableau dans un tableau VBA
   
    FinTabCodeExo = .Range("Q" & .Rows.Count).End(xlUp).Row 'idem pour le tablo des codes exercice
    TabCodeExo = .Range("Q3:S" & FinTabCodeExo).Value
   
    FinTabCodePériode = .Range("C" & .Rows.Count).End(xlUp).Row 'et pour le tablo des codes périodes
    TabCodePériode = .Range("C3:J" & FinTabCodePériode).Value
   
    For i = LBound(TabCodePériode, 1) To UBound(TabCodePériode, 1) 'pour chaque code du tablo (1ere colonne)
        If Not DicoCodePériode.exists(TabCodePériode(i, 1)) Then DicoCodePériode.Add TabCodePériode(i, 1), i 'on crée une entrée dans le dico avec un numéro de valeur
    Next i
   
    For Each JF In .Range("Fer").Columns(1).Value 'pour chaque Jour Férié de range nommée "FER" on créé une entrée dans le dico
        If Not dicoJourFériés.exists(JF) Then dicoJourFériés.Add JF, "F"
    Next JF
   
End With

'on a ici tous les éléments pour remplir le tableau final
k = 1
For i = LBound(TabPériode, 1) To UBound(TabPériode, 1) 'pour chaque ligne du tablo "CodePériode" colonne M à O
    For j = TabPériode(i, 1) To TabPériode(i, 2) 'pour j du premier jour au dernier jour de la période
        tablo(k, 1) = j 'on met le Jour j dans la première colonne du tablo final
        tablo(k, 2) = TabPériode(i, 3) 'on y colle le Code Période associé en seconde colonne
        tablo(k, 3) = TabCodeExo(Month(tablo(k, 1)), 3) 'et on récupère le code exercice dans le tablo CodeExo situé à la ligne correspond au numéro du mois du jour J
        If dicoJourFériés.exists(tablo(k, 1)) Then 'si le jour est un Jour Férié, on met 7+1 (correspond à ta formule de la colonne AA)
            IndiceTab = 7 + 1
        Else
            IndiceTab = Weekday(tablo(k, 1), 2) + 1 'sinon on met le numéro du jour (correspond à ta colonne Y)
        End If
        tablo(k, 4) = TabCodePériode(DicoCodePériode(tablo(k, 2)), IndiceTab) 'on place en 4eme colonne le code récupéré dans le tablo de correspondance (colonnes C à J)
        k = k + 1
    Next j
Next i
ActiveSheet.Range("U3").Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo 'on colle le résultat final dans les colonnes U à X

End Sub