XL 2013 changer la valeur d'une plage en fonction du texte d'une cellule

CGU2022. · 28 Septembre 2022

Bonjour à toutes et à tous....
Auriez vous dans vos fichiers une vba ou bien quelques lignes de codes qui :

Click forme: lance macro si dessous.

si valeur cellule A1 = x (Feuil1)
va dans Feuil1 (2) et met les cellules (a1:a20 à 1

si valeur cellule A1 = y
va dans Feuil1 (2) et met les cellules (b1:b20) à 1

si valeur cellule A1 = z
va dans Feuil1 (2) et met les cellules (c1:c20) à 1

merci

sylvanu · 28 Septembre 2022

Bonjour CGU, Vgendron
Un essai en PJ avec :

VB:

Sub Ecrit()
Select Case [A1]
    Case "x": Feuil1.[A1:A20] = 1
    Case "y": Feuil1.[B1:B20] = 1
    Case "z": Feuil1.[C1:C20] = 1
End Select
End Sub

vgendron · 28 Septembre 2022

bonjour

un essai en PJ

VB:

Sub test()

With Sheets("Feuil1") 'dans la feuille 1
    valeur = .Range("A1") 'on récupère le contenu de la cellule A1
End With

Select Case valeur 'selon la valeur, on affecte le numéro de colonne à la variable col
    Case "x"
        col = 1
    Case "y"
        col = 2
    Case "z"
        col = 3
End Select

With Sheets("Feuil1 (2)") 'dans la feuille
    .Cells(1, col).Resize(20, 1) = 1 'on met des 1 sur 20 lignes de la colonne choisie
End With
End Sub

sylvanu · 28 Septembre 2022

Bonjour CGU, Vgendron
Un essai en PJ avec :

VB:

Sub Ecrit()
Select Case [A1]
    Case "x": Feuil1.[A1:A20] = 1
    Case "y": Feuil1.[B1:B20] = 1
    Case "z": Feuil1.[C1:C20] = 1
End Select
End Sub

CGU2022. · 28 Septembre 2022

sylvanu à dit:
Bonjour CGU, Vgendron
Un essai en PJ avec :

VB:

Sub Ecrit() Select Case [A1] Case "x": Feuil1.[A1:A20] = 1 Case "y": Feuil1.[B1:B20] = 1 Case "z": Feuil1.[C1:C20] = 1 End Select End Sub

Bonjour
Excellent je ne connaissais pas c'est très rapide et j'ai même masquer des colonnes

Case "x": Feuil1.[A1:A20] = 1
Columns("I:M").Hidden = True 'Affiche plage de colonne de I à M
Range("D,G:G").EntireColumn.Hidden = False 'masque colonne nomées D et G

Comment faire sans le bouton sur simple changement de la Case [A1].

Un grand merci..

CGU2022. · 28 Septembre 2022

vgendron à dit:

bonjour

un essai en PJ

VB:

Sub test()

With Sheets("Feuil1") 'dans la feuille 1
    valeur = .Range("A1") 'on récupère le contenu de la cellule A1
End With

Select Case valeur 'selon la valeur, on affecte le numéro de colonne à la variable col
    Case "x"
        col = 1
    Case "y"
        col = 2
    Case "z"
        col = 3
End Select

With Sheets("Feuil1 (2)") 'dans la feuille
    .Cells(1, col).Resize(20, 1) = 1 'on met des 1 sur 20 lignes de la colonne choisie
End With
End Sub

Bonjour et merci pour ta réponse .... je vais l'étudier également....

laurent950 · 28 Septembre 2022

Bonsoir,

CGU2022. à dit:
Comment faire sans le bouton sur simple changement de la Case [A1].

Me.Cells(1, 1) = [A1] de la feuil1
Il suffit de coller le Module ci-dessous : Dans la "Feuil2"

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Cells(1, 1)) Is Nothing Then
        Select Case Me.Cells(1, 1).Value
               Case "x": Feuil1.Range("A1:A20") = "1"
                Case "y": Feuil1.Range("B1:B20") = "1"
                Case "z": Feuil1.Range("C1:C20") = "1"
        End Select
    End If
End Sub

Staple1600 · 28 Septembre 2022

Bonsoir le fil

Pour ... comme son nom l'indique

VB:

Sub Pour_Le_Fun()
Range(Chr(Asc([A1]) - 23) & "1").Resize(20) = 1
End Sub

Et en évènementielle

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then Range(Chr(Asc([A1]) - 23) & "1").Resize(20) = 1
End Sub

Staple1600 · 28 Septembre 2022

Excusez-moi, j'ai chu et je me suis cogné la teuté

Une dernière pour la route

VB:

Private Sub Worksheet_Change(ByVal UmmaGumma As Range)
If UmmaGumma.Address = "$A$1" Then
Cells(1, Chr((-97 * (UmmaGumma = "x")) + (-98 * (UmmaGumma = "y")) + (-99 * (UmmaGumma = "z")))).Resize(20) = 1
End If
End Sub

NB: Attention aux effets de bord.

XL 2013 changer la valeur d'une plage en fonction du texte d'une cellule

CGU2022.

XLDnaute Junior

Pièces jointes

sylvanu

vgendron

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

CGU2022.

XLDnaute Junior

CGU2022.

XLDnaute Junior

laurent950

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Discussions similaires