Integrer une formule dans le bon nombre de champs

RICO@17

XLDnaute Nouveau
Bonjour,

J'ai cree une macro et je voudrais que le format de mon tableau s'adapte uniquement au nombre d'entrees, pour que toute la partie inutile a partir de la ligne 151 disparaisse.

Il faudrait que les colonnes A,G et O se completent uniquement s'il y a quelque chose dans la colonne B.

Par exemple, pour la colonne G:

'Funded by
Range("G4").Select
ActiveCell.Formula = "=VLOOKUP(E4,$R$10:$S$20,2,FALSE)"
Range("G4").Select
Selection.AutoFill Destination:=Range("G4:G174")

Au lieu d'avoir un autofill de G4 a G174 je voudrais un autofill de G4 a Gn ou n = le nombre de personnes (par ex si 100 personnes autofill de G4 a G103)

Merci d'avance

:D
 

Pièces jointes

  • TEST.xlsm
    54 KB · Affichages: 45
  • TEST.xlsm
    54 KB · Affichages: 48
  • TEST.xlsm
    54 KB · Affichages: 44

Fred0o

XLDnaute Barbatruc
Re : Integrer une formule dans le bon nombre de champs

Bonjour RICO@17,

Pour cela, il te faut rechercher la dernière ligne utilisée et la stocker dans une variable (appelée dans mon exemple : dl) :
VB:
    Dim dl As Integer
    dl = Sheets("Example").Range("B65536").End(xlUp).Row

Ensuite, au lieu d'utiliser 174 dans ta macro, tu utilises la variable "dl", comme ceci :
VB:
'Funded by
    Range("G4").Select
    ActiveCell.Formula = "=VLOOKUP(E4,$R$10:$S$20,2,FALSE)"
    Range("G4").Select
    Selection.AutoFill Destination:=Range("G4:G" & dl)
    
'Building Type
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "Maison mere"
    Range("A4").Select
    Selection.AutoFill Destination:=Range("A4:A" & dl)
    
'Days
    Range("O4").Select
    ActiveCell.FormulaR1C1 = _
        "=INDEX(FREQUENCY(ROW(INDIRECT(R4C[2]&"":""&R4C[3])),RC[-2]:RC[-1]),2)"
    Range("O4").Select
    Selection.AutoFill Destination:=Range("O4:O" & dl)

Je pense que cela devrait répondre à ton besoin.

A+
 
C

Compte Supprimé 979

Guest
Re : Integrer une formule dans le bon nombre de champs

Bonjour Rico@17, salut Fred0o ;)

Comme l'a dis Fred0o, il faut trouver la dernière ligne du tableau
Voici le code optimisé
VB:
Sub Civilian()
  Dim DLig As Long
  'To hide Excel loading
  On Error GoTo Restore
  With Application
    '.ScreenUpdating = False
    '.Calculation = xlCalculationManual
  End With


  'Clear content of the active sheet
  With Sheets("Example")
    '.Activate
    DLig = .Range("B" & Rows.Count).End(xlUp).Row
    .Range("A4:O" & DLig).Clear
  End With


  ' With sheet Raw Data
  With Sheets("Raw Data")
    .Range("RD_RD").AutoFilter Field:=2, Criteria1:="=CIV", _
                               Operator:=xlOr, Criteria2:="=ICC"


    'Copy content from Raw Data to Active Sheet
    .Range("RD_NAME").Copy Destination:=Sheets("Example").Range("B4")
    .Range("RD_NATIONALITY").Copy Destination:=Sheets("Example").Range("E4")
    .Range("RD_CE").Copy Destination:=Sheets("Example").Range("F4")
    .Range("RD_ROOM").Copy Destination:=Sheets("Example").Range("L4")
    .Range("RD_Date_Arrived").Copy Destination:=Sheets("Example").Range("M4")
    .Range("RD_Date_Depart").Copy Destination:=Sheets("Example").Range("N4")


    'Clear filter from Raw Data Tab
    .ShowAllData
  End With


  With Sheets("Example")
    DLig = .Range("B" & Rows.Count).End(xlUp).Row
    'Funded by
    With .Range("G4")
      .FormulaLocal = "=RECHERCHEV(E4;$R$10:$S$20;2;FAUX)"
      .AutoFill Destination:=Range("G4:G" & DLig)
    End With
    'Building Type
    .Range("A4:A" & DLig).Value = "Maison mere"
    'Days
    With .Range("O4")
      .FormulaLocal = "=INDEX(FREQUENCE(LIGNE(INDIRECT(Q$4&"":""&R$4));M4:N4);2)"
      .AutoFill Destination:=Range("O4:O" & DLig)
    End With
    'Layout
    .Rows(8).RowHeight = 12.75
    .Columns(1).ColumnWidth = 15
    .Columns(2).ColumnWidth = 24
    .Columns(3).ColumnWidth = 11.14
    .Columns(4).ColumnWidth = 7.43
    .Columns(5).ColumnWidth = 14
    .Columns(6).ColumnWidth = 7.43
    .Columns(7).ColumnWidth = 12
    .Columns(8).ColumnWidth = 7.29
    .Columns(9).ColumnWidth = 9.29
    .Columns(10).ColumnWidth = 15.14
    .Columns(11).ColumnWidth = 8.43
    .Columns(12).ColumnWidth = 9.14
    .Columns(13).ColumnWidth = 9.43
    .Columns(14).ColumnWidth = 9.43
    .Columns(15).ColumnWidth = 5.29


    With .Range("CIV_Result")
      With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
      End With
      With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
      End With
      With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
      End With
      With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
      End With
      With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
      End With
      With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
      End With
    End With
    .Range("Q4").Select


    'Set Print Area
    ActiveSheet.PageSetup.PrintArea = "CIV_Print"


    'To hide Excel loading
Restore:
    With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationAutomatic
    End With
  End With
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo