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
'--
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
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 '--
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" <messages@venir.fr> a écrit dans le message de groupe de discussion :
#1biN6Z4KHA.4336@TK2MSFTNGP04.phx.gbl...
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
'--
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 '--