Insérer une formule dans les cellules d'un tableau en VBA

[BChaly]

Bonsoir à tous,

Je cherche à insérer une formule dans deux tableaux ("Classement A" - colonne "I5:I9") et ("Classement B" - colonne "I13:I19") situés sur une feuille.

Ces tableaux auront un nombre de ligne variable.

Ma macro (voir fichier joint) ne fonctionnant pas, quelqu'un a-t-il une solution?

Cordialement,

BChaly


**************************************************
Code:

Option Explicit

Sub Formule()

Dim cell As Range
Dim NbLigne As Long

NbLigne = [C65536].End(xlUp).Row - 12

For Each cell In Sheets("Sheet1").Range("C4:J50")

'Inserer formule dans colonne ("I5:I9")

If cell.Value = "T1" Then cell.Offset(1, 0).Resize(NbLigne).FormulaR1C1 = _
"=INDEX(R5C3:R9C4,MATCH(ROWS(R5C:RC)-1,R5C[-7]:R9C[-7],0),1)"

'Inserer formule dans colonne ("I13:I19")

If cell.Value = "T2" Then cell.Offset(1, 0).Resize(NbLigne).FormulaR1C1 = _
"=INDEX(R13C3:R19C4,MATCH(ROWS(R13C:RC)-1,R13C[-7]:R19C[-7],0),1)"

Next

End Sub

**************************************************

 

[job75]

Re : Insérer une formule dans les cellules d'un tableau en VBA

Bonsoir BChaly,

Pas vraiment étudié la macro et les formules de la feuille.

Mais il y a des valeurs d'erreur #N/A [Edit : qui se forment] dans la plage.

Alors au lieu d'utiliser la propriété Value utiliser la propriété Text :

If cell.Text = "T1" Then
'---
If cell.Text = "T2" Then

A+

 

[JNP]

Re : Insérer une formule dans les cellules d'un tableau en VBA

Bonsoir BChaly, Gérard ,
A tester

Sub Formule()
Dim cell As Range, DerLigne As Byte
For Each cell In Sheets("Sheet1").Range("I4:I50")
    If cell.Value Like "T?" Then
        
        DerLigne = cell.Offset(0, -6).End(xlDown).Row
        
        cell.Offset(1, 0).Resize(DerLigne - cell.Row).FormulaR1C1 = _
            "=INDEX(R" & cell.Row + 1 & "C3:R" & DerLigne & _
            "C4,MATCH(ROWS(R" & cell.Row + 1 & "C:RC)-1,R" & _
            cell.Row + 1 & "C[-7]:R" & DerLigne & "C[-7],0),1)"
            
        cell.Offset(1, 1).Resize(DerLigne - cell.Row).FormulaR1C1 = _
            "=INDEX(R" & cell.Row + 1 & "C3:R" & DerLigne & _
            "C4,MATCH(ROWS(R" & cell.Row + 1 & "C[-1]:RC[-1])-1,R" _
            & cell.Row + 1 & "C[-8]:R" & DerLigne & "C[-8],0),2)"
    End If
Next
End Sub

Bonne soirée

 

[job75]

Re : Insérer une formule dans les cellules d'un tableau en VBA

Bonjour BChaly, bonjour JNP

Bien compris comme toi Jean-Noël que les tableau sont extensibles.

Une autre méthode, et une autre formule (et une seule en colonnes I et J) :

Sub Formule()
Dim a As Range, ad$, F$
For Each a In [B:B].SpecialCells(xlCellTypeFormulas, 1).Areas
  ad = a.Resize(, 3).Address(ReferenceStyle:=xlR1C1)
  F = "=VLOOKUP(ROWS(R1:R[" & 1 - a.Row & "])-1," & ad & ",COLUMNS(C9:C[1]),0)"
  Intersect(a.EntireRow, [I:J]).FormulaR1C1 = F
Next
End Sub

Fichier joint.

A+

 

[job75]

Re : Insérer une formule dans les cellules d'un tableau en VBA

Re,

Cela dit je ne vois pas pourquoi on s'embarrasse de formules, un simple tri suffit :

Sub Classement()
Dim a As Range, plage As Range
For Each a In [D:D].SpecialCells(xlCellTypeFormulas, 1).Areas
  Set plage = a.Offset(, -1).Resize(, 2)
  With plage.Offset(, 6)
    .Value = plage.Value 'copie les valeurs
    .Sort [J1] 'tri
  End With
Next
End Sub

Fichier (2).

A+

 

[BChaly]

Re : Insérer une formule dans les cellules d'un tableau en VBA

Bonjour JNP, Bonjour Job75,

Génial!!!

Vos solutions sont fantastiques et fonctionnent parfaitement.

Un immense Merci à tous les deux pour votre aide.

Cordialement.

 

[job75]

Re : Insérer une formule dans les cellules d'un tableau en VBA

Re,

Si l'on est particulièrement fainéant on peut même mettre en forme automatiquement :

Sub Classement()
Dim a As Range, plage As Range
Application.ScreenUpdating = False
[I:J].Clear 'efface tout
For Each a In [D:D].SpecialCells(xlCellTypeFormulas, 1).Areas
  Set plage = a.Offset(, -1).Resize(, 2)
  With plage.Offset(, 6)
    .Value = plage.Value 'copie les valeurs
    .Sort [J1] 'tri
    '---mises en formes---
    .HorizontalAlignment = xlCenter
    .Columns(1).Interior.ColorIndex = 37
    .Borders.LineStyle = 1
    With .Offset(-2).Resize(2)
      .HorizontalAlignment = xlCenter
      .Interior.ColorIndex = 15
      .Borders.LineStyle = 1
      .Rows(1).Merge
      .Cells(1, 1) = "Classement"
      .Cells(2, 1) = plage(0, 1)
      .Cells(2, 2) = "Qte"
    End With
  End With
Next
End Sub

Fichier (3).

A+

 

[BChaly]

Re : Insérer une formule dans les cellules d'un tableau en VBA

Vraiment Très Fort, Bravo!!!

Merci Mille fois!!!

Cordialement