Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Simplification code

1 réponse
Avatar
JPascal
Bonjour à tous,

Comment puis-je simplifier ce code avec des boucles ?
Merci d'avance pour votre aide !

'--
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Address = [a15].Address Then
Rows("16:1400").Sort Key1:=[a1], Key2:=[b1], Key3:=[e1]
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [b15].Address Then
Rows("16:1400").Sort Key1:=[b1]
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [c15].Address Then
Rows("16:1400").Sort Key1:=[C1]
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [d15].Address Then
Rows("16:1400").Sort Key1:=[D1]
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [e15].Address Then
Rows("16:1400").Sort Key1:=[e1]
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [f15].Address Then
NbLignes =
Application.WorksheetFunction.CountA(Range("B16:B1400"))
Rows("16:" & NbLignes + 15).Sort Key1:=[F1],
Order1:=xlAscending
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [g15].Address Then
Rows("16:1400").Sort Key1:=[g1], Order1:=xlAscending
ActiveWindow.ScrollRow = 15
End If

If Target.Address = [b13].Address Then [b16].End(xlDown).Offset(1,
0).Select
If Target.Address = [b11].Address Then ActiveWindow.ScrollRow =
[i1] 'Today

If Target.Address = [c2].Address Then ActiveWindow.ScrollRow =
Range("I2").Value
If Target.Address = [c3].Address Then ActiveWindow.ScrollRow =
Range("I3").Value
If Target.Address = [c4].Address Then ActiveWindow.ScrollRow =
Range("I4").Value
If Target.Address = [c5].Address Then ActiveWindow.ScrollRow =
Range("I5").Value
If Target.Address = [c6].Address Then ActiveWindow.ScrollRow =
Range("I6").Value
If Target.Address = [c7].Address Then ActiveWindow.ScrollRow =
Range("I7").Value
If Target.Address = [c8].Address Then ActiveWindow.ScrollRow =
Range("I8").Value
If Target.Address = [c9].Address Then ActiveWindow.ScrollRow =
Range("I9").Value
If Target.Address = [c10].Address Then ActiveWindow.ScrollRow =
Range("I10").Value
If Target.Address = [c11].Address Then ActiveWindow.ScrollRow =
Range("I11").Value
If Target.Address = [c12].Address Then ActiveWindow.ScrollRow =
Range("I12").Value
If Target.Address = [c13].Address Then ActiveWindow.ScrollRow =
Range("I13").Value

If Target.Address = [h2].Address Then
MaPlage = [j2]
Call Imprimer
End If
If Target.Address = [h3].Address Then
MaPlage = [j3]
Call Imprimer
End If
If Target.Address = [h4].Address Then
MaPlage = [j4]
Call Imprimer
End If
If Target.Address = [h5].Address Then
MaPlage = [j5]
Call Imprimer
End If
If Target.Address = [h6].Address Then
MaPlage = [j6]
Call Imprimer
End If
If Target.Address = [h7].Address Then
MaPlage = [j7]
Call Imprimer
End If
If Target.Address = [h8].Address Then
MaPlage = [j8]
Call Imprimer
End If
If Target.Address = [h9].Address Then
MaPlage = [j9]
Call Imprimer
End If
If Target.Address = [h10].Address Then
MaPlage = [j10]
Call Imprimer
End If
If Target.Address = [h11].Address Then
MaPlage = [j11]
Call Imprimer
End If
If Target.Address = [h12].Address Then
MaPlage = [j12]
Call Imprimer
End If
If Target.Address = [h13].Address Then
MaPlage = [j13]
Call Imprimer
End If
End Sub
'--

1 réponse

Avatar
michdenis
Bonjour,

Une façon de faire :

Attention aux lignes coupées par le service de messagerie.

'----------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim NbLignes As Long
Select Case Target.Address(0, 0)
Case Is = "A15"
Rows("16:1400").Sort Key1:=[a1], Key2:=[b1], Key3:=[e1]
ActiveWindow.ScrollRow = 15
Case Is = "B15", "C15", "D15", "E15", "G15"
Rows("16:1400").Sort Key1:Îlls(1, Target.Column)
ActiveWindow.ScrollRow = 15
Case Is = "F15"
NbLignes = Application.WorksheetFunction.CountA(Range("B16:B1400"))
Rows("16:" & NbLignes + 15).Sort Key1:=[F1], Order1:=xlAscending
ActiveWindow.ScrollRow = 15
End Select

If Target.Address = [b13].Address Then [b16].End(xlDown).Offset(1, 0).Select
If Target.Address = [b11].Address Then ActiveWindow.ScrollRow = [i1] 'Today

Select Case Target.Address(0, 0)
Case Is = "C2", "C3", "C4", "C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13"
ActiveWindow.ScrollRow = Cells(Target.Row, "I").Value
End Select
Select Case Target.Address(0, 0)
Case Is = "H2", "J2", "J3", "H4", "H5", "H6", "H7", "H8", "H9", "H10", "H11", "H12",
"H13"
MaPlage = Target.Offset(, 1)
Call Imprimer
End Select
End Sub
'----------------------------------------


"JPascal" a écrit dans le message de groupe de discussion :
#
Bonjour à tous,

Comment puis-je simplifier ce code avec des boucles ?
Merci d'avance pour votre aide !

'--
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Address = [a15].Address Then
Rows("16:1400").Sort Key1:=[a1], Key2:=[b1], Key3:=[e1]
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [b15].Address Then
Rows("16:1400").Sort Key1:=[b1]
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [c15].Address Then
Rows("16:1400").Sort Key1:=[C1]
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [d15].Address Then
Rows("16:1400").Sort Key1:=[D1]
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [e15].Address Then
Rows("16:1400").Sort Key1:=[e1]
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [f15].Address Then
NbLignes Application.WorksheetFunction.CountA(Range("B16:B1400"))
Rows("16:" & NbLignes + 15).Sort Key1:=[F1],
Order1:=xlAscending
ActiveWindow.ScrollRow = 15
End If
If Target.Address = [g15].Address Then
Rows("16:1400").Sort Key1:=[g1], Order1:=xlAscending
ActiveWindow.ScrollRow = 15
End If

If Target.Address = [b13].Address Then [b16].End(xlDown).Offset(1,
0).Select
If Target.Address = [b11].Address Then ActiveWindow.ScrollRow [i1] 'Today

If Target.Address = [c2].Address Then ActiveWindow.ScrollRow Range("I2").Value
If Target.Address = [c3].Address Then ActiveWindow.ScrollRow Range("I3").Value
If Target.Address = [c4].Address Then ActiveWindow.ScrollRow Range("I4").Value
If Target.Address = [c5].Address Then ActiveWindow.ScrollRow Range("I5").Value
If Target.Address = [c6].Address Then ActiveWindow.ScrollRow Range("I6").Value
If Target.Address = [c7].Address Then ActiveWindow.ScrollRow Range("I7").Value
If Target.Address = [c8].Address Then ActiveWindow.ScrollRow Range("I8").Value
If Target.Address = [c9].Address Then ActiveWindow.ScrollRow Range("I9").Value
If Target.Address = [c10].Address Then ActiveWindow.ScrollRow Range("I10").Value
If Target.Address = [c11].Address Then ActiveWindow.ScrollRow Range("I11").Value
If Target.Address = [c12].Address Then ActiveWindow.ScrollRow Range("I12").Value
If Target.Address = [c13].Address Then ActiveWindow.ScrollRow Range("I13").Value

If Target.Address = [h2].Address Then
MaPlage = [j2]
Call Imprimer
End If
If Target.Address = [h3].Address Then
MaPlage = [j3]
Call Imprimer
End If
If Target.Address = [h4].Address Then
MaPlage = [j4]
Call Imprimer
End If
If Target.Address = [h5].Address Then
MaPlage = [j5]
Call Imprimer
End If
If Target.Address = [h6].Address Then
MaPlage = [j6]
Call Imprimer
End If
If Target.Address = [h7].Address Then
MaPlage = [j7]
Call Imprimer
End If
If Target.Address = [h8].Address Then
MaPlage = [j8]
Call Imprimer
End If
If Target.Address = [h9].Address Then
MaPlage = [j9]
Call Imprimer
End If
If Target.Address = [h10].Address Then
MaPlage = [j10]
Call Imprimer
End If
If Target.Address = [h11].Address Then
MaPlage = [j11]
Call Imprimer
End If
If Target.Address = [h12].Address Then
MaPlage = [j12]
Call Imprimer
End If
If Target.Address = [h13].Address Then
MaPlage = [j13]
Call Imprimer
End If
End Sub
'--