code VBA pour remplacer formule

SLIJACK

XLDnaute Nouveau
Bonsoir à tous!!!
peut on faire un code VBA pour remplacer la formule ci dessous

=SI(ET(A5=1;F5="demi étage accès par arrière bât");"PMR";SI(ET(A5=1;F5="demi étage");"PMR";SI(ET(A5=1;C5=3;D5="RDC");"PMR";SI(ET(A5=1;C5=2;D5="RDC");"Accessible Fauteuil";SI(ET(A5<>"";D5="RDC");"Possible Fauteuil";SI(ET(A5<>"";D5="1er ETAGE");"PMR";""))))))

je joint un bout de tableau la formule se trouve dans la colonne "L" et sur toute sa longueur.
Dans le tableau finale la colonne "A" sera la "G" et la colonne "C" sera la "I", ceci a titre indicatif si j'ai un retour je ferai les modifs moi même.

un grand merci par avance de votre aide.
 

Pièces jointes

  • Classeur1.xlsm
    12.2 KB · Affichages: 53
  • Classeur1.xlsm
    12.2 KB · Affichages: 55
  • Classeur1.xlsm
    12.2 KB · Affichages: 55

Hulk

XLDnaute Barbatruc
Re : code VBA pour remplacer formule

Hello Slijack,

Essaie ce code..
Code:
Private Sub CommandButton1_Click()
    
    Dim cel As Range
    
    For Each cel In Range([A5], [A34].End(xlUp))
        If Range("A" & cel.Row).Value = 1 And Range("F" & cel.Row) = "demi étage accès par arrière bât" Then
            Range("L" & cel.Row) = "PMR"
        Else
            If Range("A" & cel.Row) = 1 And Range("F" & cel.Row) = "demi étage" Then
                Range("L" & cel.Row) = "PMR"
            Else
                If Range("A" & cel.Row) = 1 And Range("C" & cel.Row) = 3 And Range("D" & cel.Row) = "RDC" Then
                    Range("L" & cel.Row) = "PMR"
                Else
                    If Range("A" & cel.Row) = 1 And Range("C" & cel.Row) = 2 And Range("D" & cel.Row) = "RDC" Then
                        Range("L" & cel.Row) = "Accessible Fauteuil"
                    Else
                        If Range("A" & cel.Row) <> "" And Range("D" & cel.Row) = "RDC" Then
                            Range("L" & cel.Row) = "Possible Fauteuil"
                        Else
                            If Range("A" & cel.Row) <> "" And Range("D" & cel.Row) = "1er ETAGE" Then
                                Range("L" & cel.Row) = "PMR"
                            Else
                                Range("L" & cel.Row) = ""
                            End If
                        End If
                    End If
                End If
            End If
        End If
    Next cel
    
End Sub
 

kjin

XLDnaute Barbatruc
Re : code VBA pour remplacer formule

Bonsoir, salut Hulk :),
Code:
'SI(ET(A5=1;F5="demi étage accès par arrière bât");"PMR"
'SI(ET(A5=1;F5="demi étage");"PMR"
'SI(ET(A5=1;C5=2;D5="RDC");"Accessible Fauteuil"
'SI(ET(A5<>"";D5="RDC");"Possible Fauteuil"
'SI(ET(A5<>"";D5="1er ETAGE");"PMR"
'Dans le tableau finale la colonne "A" sera la "G" et la colonne "C" sera la "I"
For i = 4 To ActiveSheet.UsedRange.Rows.Count
If Range("G" & i) <> "" Then
    Select Case Range("G" & i)
        Case 1
        If Range("F" & i) = "demi étage accès par arrière bât" Then Range("L" & i) = "PMR"
        If Range("F" & i) = "demi étage" Then Range("L" & i) = "PMR"
        If Range("I" & i) = 2 And Range("D" & i) = "RDC" Then Range("L" & i) = "Accessible Fauteuil"
        Case Else
        If Range("D" & i) = "RDC" Then Range("L" & i) = "Possible Fauteuil"
        If Range("D" & i) = "1er ETAGE" Then Range("L" & i) = "PMR"
    End Select
End If
Next
A+
kjin
 

SLIJACK

XLDnaute Nouveau
Re : code VBA pour remplacer formule

bonjour à tous
tout d'abord merci pour vos réponses qui mon réellement bien aidé;

Mais je reviens avec mon tableau presque terminé, j'ai essayé sans succès de le finaliser, donc je fais une nouvelle fois appel a votre savoir.
mon nouveau problème est que je voudrai inséré dans le code VBA les formules de la colonne "U" qui est la suivante:
"=SI(OU(R5<>"";S5<>"");AS5;SI(OU(Q5="*";R5<>"";S5<>"");AP5;""))
est que le résultat s'affiche dans la dite colonne.
encore merci d'avance.
 

Pièces jointes

  • Appartements Aménagés adaptés adaptables.xlsm
    37.7 KB · Affichages: 36

Statistiques des forums

Discussions
312 559
Messages
2 089 604
Membres
104 224
dernier inscrit
Brilma