Inversion de lignes

[cheyenne63]

Bonjour,

Dans le classeur simplifié joint :
Une feuille « BD » : une base de données
Une feuille « Result » : recherche d’infos issues de la BD (avec liste déroulante en C3)
Est-il possible, en associant une macro propre à chaque flèche de la feuille Result, inverser deux lignes de la feuille BD.
Exemple : je suis dans l’onglet Résult, je sélectionne en C3 Blabla2. Le Résultat 1 est Tutu, le second est Reblabla. En cliquant sur la flèche bleue du haut, je souhaiterai inverser le résultat 1 avec le résultat 2 afin qu’à l’avenir Reblabla apparaisse en face de résultat 1 et Tutu en face de résultat 2.

Si cela est possible, je voudrai également que les flèches soient désactivées (ou que les macros renvoient un message d'erreur) lorsque bien sûr il n’y a pas de résultat en face.

J’espère avoir été suffisamment claire pour une fois.

Merci d’avance et bonne journée.

 

[cheyenne63]

Re : Inversion de lignes

Bonsoir,
Est-ce incompréhensible, farfelu, ou simplement infaisable ?

 

[job75]

Re : Inversion de lignes

Bonsoir cheyenne63,

Est-ce incompréhensible, farfelu, ou simplement infaisable ?

Aucunement, et c'est un joli problème.

Voyez le fichier joint et ces macros dans Module1 (Alt+F11) :

Sub Descend()
Inversion 2
End Sub

Sub Monte()
Inversion 0
End Sub

Sub Inversion(s As Byte)
Dim P As Range, L As Range, t As String, tablo
With Sheets("BD")
  Set P = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set L = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(, -3)
t = [C3] & L & L(1, 2) & L(1, 3)
If L <> "" And L(s) <> "" Then
  For Each P In P
    If P & P(1, 2) & P(1, 3) & P(1, 4) = t Then
      tablo = P.Resize(, 4)
      P.Resize(, 4) = P(s).Resize(, 4).Value
      P(s).Resize(, 4) = tablo
      Exit Sub
    End If
  Next
Else
  MsgBox "Pas question !"
End If
End Sub

On remarquera que la macro Inversion est paramétrée, ce qui économise du code.

Edit : cette solution fonctionne sur Excel 2003 mais pas sur Excel 2010, très curieux ça, il faut utiliser :

t = [C3] & L & L.Offset(, 1) & L.Offset(, 2)

Pas de problème pour la version (2) qui suit.

A+

 

[job75]

Re : Inversion de lignes

Re,

La macro précédente supposait que 2 lignes dans la BDD n'étaient jamais identiques.

Avec cette macro, qui s'appuie sur le n° de ligne, elles peuvent l'être sans problème :

Sub Inversion(s As Byte)
Dim P As Range, L As Range, lig&, compte As Boolean, n&, tablo
With Sheets("BD")
  Set P = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set L = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(, -3)
lig = L.Row - 10 '10 à adapter éventuellement
If L <> "" And L(s) <> "" Then
  For Each P In P
    If P(1) = [C3] Then compte = True
    If compte Then n = n + 1
    If n = lig Then
      tablo = P.Resize(, 4)
      P.Resize(, 4) = P(s).Resize(, 4).Value
      P(s).Resize(, 4) = tablo
      Exit Sub
    End If
  Next
Else
  MsgBox "Pas question !"
End If
End Sub

Fichier (2).

A+

 

[cheyenne63]

Re : Inversion de lignes

C'est magnifique !
Merci beaucoup et bonne journée

 

[job75]

Re : Inversion de lignes

Re,

Les solutions précédentes supposaient que la base de donnée était triée sur la colonne A.

Voici une solution générale qui fonctionne même si la base n'est pas triée.

1) Formule matricielle en C11 de la feuille "Result" :

=SI(LIGNES($1:1)<=NB.SI(BD!$A$2:$A$25;$C$3);INDEX(BD!B$2:B$25;PETITE.VALEUR(SI(BD!$A$2:$A$25=$C$3;LIGNE(BD!$A$2:$A$25)-1);LIGNES($1:1)));"")

A valider par Ctrl+Maj+Entrée et à copier sur C11:E19.

2) La macro est plus compliquée bien sûr :

Sub Inversion(s As Byte)
Dim L As Range, lig&, P As Range, tablo, t$, mem(), i&, n&, temp
Set L = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(, -3)
lig = L.Row - 10 '10 à adapter éventuellement
If L <> "" And L(s) <> "" Then
  With Sheets("BD")
    Set P = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)(2))
  End With
  tablo = P 'matrice, plus rapide
  t = [C3]
  ReDim mem(1 To Application.CountIf(P, t))
  For i = 1 To UBound(tablo)
    If tablo(i, 1) = t Then
      n = n + 1
      mem(n) = i 'mémorise le n° de ligne
      If n = lig + 1 Then Exit For
    End If
  Next
  temp = P(mem(lig)).Resize(, 4)
  P(mem(lig)).Resize(, 4) = P(mem(lig + s - 1)).Resize(, 4).Value
  P(mem(lig + s - 1)).Resize(, 4) = temp
Else
  MsgBox "Pas question !"
End If
End Sub

L'exécution est rapide même sur une grande BDD.

Fichier (3).

A+

 

[cheyenne63]

Re : Inversion de lignes

Re
Bien sûr, j'essaie d'adapter le tout à mon classeur ... et ça bug !
C'est bien ça, ça permet de chercher et de tenter de comprendre. Sauf qu'au bout de deux heures ...
Donc, je voudrais savoir à quoi correspond le -3 à la fin de la ligne

Set L = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(, -3)

Merci d'avance

 

[cheyenne63]

Re : Inversion de lignes

M'en fallait une de plus (d'heure !)
J'ai compris ... lol