Trié sur colonne définie + Ajout de formule en VBA

[sadness78]

Bonjour,

Je reviens vers vous avec un petit soucis.

J'aimerais qu'au final les étapes de ma Macro soit les suivantes :

- Trier les données par ordre croissant sur la colonne A

- Supprimer les lignes contenenant la lettre "W" dans la colonne A

- Créer 3 colonnes avec formules jusqu'à la dernière ligne non vide

Voici le code que j'ai essayé de faire mais qui comporte je pense quelques erreurs :

Sub test()

Dim LastLig As Long
Dim LastLig2 As Long

Columns("A:A").Select
Selection.Sort Key1:=Range("A1")

Application.ScreenUpdating = False
With Sheets("Source")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("A1:A65536" & LastLig).AutoFilter field:=1, Criteria1:="W"
    On Error Resume Next
    .Range("A2:A65536" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0
    .AutoFilterMode = False
End With

'Application.ScreenUpdating = False
'With Sheets("Source")
'   .AutoFilterMode = False
'    LastLig2 = .Cells(.Rows.Count, "R").End(xlUp).Row
'    .Range("A1:A65536" & LastLig).AutoFilter field:=1, Criteria1:="Not taken up"
'    On Error Resume Next
'    .Range("A2:A65536" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
'    On Error GoTo 0
'    .AutoFilterMode = False
'End With

Dim c As Range, TopCell As Range, BottomCell As Range
Dim i As Long, j As Long

' boucle (nécessaire si plusieurs colonnes à remplir !)
For Each c In Selection.Rows(1)
  
      ' définition de la cellule supérieure
      If Not IsEmpty(c) Then
Set TopCell = c
Else
Set TopCell = c.End(xlUp)
      End If
      
      ' définition de la cellule inférieure
      i = c.CurrentRegion.SpecialCells(xlCellTypeLastCell).Row
      j = c.Column
      Set BottomCell = Cells(i, j)
      
      ' remplissage
      Range(TopCell, BottomCell).FillDown
  
Next c
  
Application.ScreenUpdating = True

End Sub

Merci d'avance,

 

[GIBI]

Re : Trié sur colonne définie + Ajout de formule en VBA

Bonjour


J'ai simplifié le code de la macro

Sub test()

    Dim LastLig As Long
    Dim LastLig2 As Long

    Range("A1").CurrentRegion.Select    'selection du tableau
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                   DataOption1:=xlSortNormal

    Application.ScreenUpdating = False

    'Suppression des lignes selectionnées
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="=*w*", Operator:=xlAnd

    On Error Resume Next    ' si aucune ligne
    Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase"). _
               Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    On Error GoTo 0

    ActiveSheet.ShowAllData


    'mettre une formule dans une colonne

    LastLig = Cells(Rows.Count, 1).End(xlUp).Row
    Col = 10    ' colonne 10
    Range(Cells(2, Col), Cells(LastLig, Col)).FormulaLocal = "=h2*50"
    Application.ScreenUpdating = True

End Sub

Pour ne pas avoir de #Ref en colonne H il faut remplacer la formule =SI(A3=A2;0;1)

par =SI(INDIRECT(ADRESSE(LIGNE(A2);COLONNE(A2)))=INDIRECT(ADRESSE(LIGNE(A2)+1;COLONNE(A2)));0;1) à tirer vers le bas


Bon courage

 

[sadness78]

Re : Trié sur colonne définie + Ajout de formule en VBA

Bonjour GIBI, le forum

Il faut avouer que tes modifications sont exceptionnelles elles marchent très bien sauf pour 1 formule qu'il n'accepte pas j'ai cherché dans tout les sens et surtout toute la matinée je sèche un peu là.

Voici le code :

Sub test()

    Dim LastLig As Long
    Dim LastLig2 As Long
    Dim LastLig3 As Long

    Application.ScreenUpdating = False

  
    'mettre une formule dans une colonne

    LastLig = Cells(Rows.Count, 1).End(xlUp).Row
    Col = 9    ' colonne 9= I
    Range(Cells(2, Col), Cells(LastLig, Col)).FormulaLocal = "=SI(EXACT(B2;C2);"New Business";"Renewed Business")"
    
    
    LastLig2 = Cells(Rows.Count, 1).End(xlUp).Row
    Col1 = 10    ' colonne 10= J
    Range(Cells(2, Col1), Cells(LastLig, Col1)).FormulaLocal = "=E2/INDEX(Currency!$C$2:$C$167;EQUIV(Source!D2;Currency!$A$2:$A$167))"
    
    LastLig3 = Cells(Rows.Count, 1).End(xlUp).Row
    Col2 = 11    ' colonne 11= K
    Range(Cells(2, Col2), Cells(LastLig, Col2)).FormulaLocal = "=SI(INDIRECT(ADRESSE(LIGNE(A2);COLONNE(A2)))=INDIRECT(ADRESSE(LIGNE(A2)+1;COLONNE(A2)));0;1)"
   
    Application.ScreenUpdating = True

End Sub

Range(Cells(2, Col), Cells(LastLig, Col)).FormulaLocal = "=SI(EXACT(B2;C2);"New Business";"Renewed Business")"

Merci d'avance GIBI, le forum.

Merci pour l'aide apportée cela a été grandement utile. Merci beaucoup.

 

[sadness78]

Re : Trié sur colonne définie + Ajout de formule en VBA

Bonjour,

J'ai trouvé l'erreur : Il fallait seulement doubler les guillemets.

Range(Cells(2, Col), Cells(LastLig, Col)).FormulaLocal = "=SI(EXACT(B2;C2);""New Business"";""Renewed Business"")"

Merci à tous.

A une prochaine fois, et encore merci.

 

[sadness78]

Re : Trié sur colonne définie + Ajout de formule en VBA

Re-bonjour le forum,

J'aimerais savoir si il serait possible de compter le nombre de caractères dans une cellule avant la suppression. Je m'explique il faut que mon "W" se trouve à la 13ème position si il est sur une autre position on ne supprime pas la ligne, sans macro je n'ai pas réussi mais peut être est-il possible de faire un miracle.

Je pense que l'ajout de code VBA se ferait à cette ligne :

'Suppression des lignes selectionnées
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="=*w*", Operator:=xlAnd

    On Error Resume Next    ' si aucune ligne
    Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase"). _
               Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    On Error GoTo 0

Merci d'avance à tout le monde.