Re : Tri de valeurs
Re,
Je vais contourner le problème, je vais mettre le contenu de mes lignes VBA ci-dessous. Je m'excuse d'avance pour les manipes que cela vous obligera à faire mais au moins je suis sur que vous aurez les infos🙂
toutes les lignes ci-dessous sont à copier et à coller (Alt F11) dans la feuille 1
[I]Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Worksheets("Feuil1").Range("DH1").Value <> "" Then
Call comparaison
End If
End Sub
Sub comparaison()
Dim Msg, Style, Title, Help, Ctxt, Reponse, MyString
Dim nom As String
Dim corriger As String
Dim nbr As Integer 'nbre de lignes
Dim i As Integer
Dim r As Integer
Dim k As Integer
Dim a As Integer
'Nombre d'espèces dans la base
nbr = Worksheets("Feuil2").Range("DK1").Value
For i = 1 To nbr 'initialisation du compteur
Worksheets("Feuil2").Range("DJ" & i).Value = 0
Next i
'Nombre de pixels en commun
For i = 1 To nbr
For r = 2 To 110
If Worksheets("Feuil1").Cells(1, r).Value = Worksheets("Feuil2").Cells(i, r).Value Then
Worksheets("Feuil2").Range("DJ" & i).Value = Worksheets("Feuil2").Range("DJ" & i).Value + 1
End If
Next r
Next i
'tri des données
'Call tri
nom = Worksheets("Feuil2").Range("B1")
Msg = "Le nom de l'espèce est" & Chr(10) & nom
Style = vbYesNoCancel + vbCritical + vbDefaultButton2
Title = "Interface utilisateur "
'Affichage dans une boîte de dialogue est action en conséquence
Reponse = MsgBox(Msg, Style, Title, Help, Ctxt)
If Reponse = vbYes Then
MsgBox "Identification terminée"
'sauvegarder feuille 1 et 2
Sheets("Feuil2").Select
ActiveWorkbook.Save
'effacer le contenu de la feuille 1 et sauvegarder
Sheets("Feuil1").Select
Selection.ClearContents
ActiveWorkbook.Save
ElseIf Reponse = vbNo Then
corriger = InputBox("Veuillez entrer le nom")
For k = 2 To 112
Worksheets("Feuil2").Cells(nbr + 1, k).Value = Worksheets("Feuil1").Cells(1, k).Value
Next k
Worksheets("Feuil2").Cells(nbr + 1, 2).Value = corriger
'sauvegarder feuille 1 et 2
Sheets("Feuil2").Select
ActiveWorkbook.Save
'effacer le contenu de la feuille 1 et sauvegarder
Sheets("Feuil1").Select
Selection.ClearContents
ActiveWorkbook.Save
Else
'effacer le
'sauvegarder feuille 1 et 2
Sheets("Feuil2").Select
ActiveWorkbook.Save
'contenu de la feuille 1 et sauvegarder
Sheets("Feuil1").Select
Selection.ClearContents
ThisWorkbook.Close True
Exit Sub
End If
End Sub
Sub tri()
Sheets("Feuil2").Select
Range("B1😀J5").Select
Range("DJ5").Activate
Selection.Sort Key1:=Range("DJ1"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub[/I]
Ci-joint le fichier avec les données sans le code VBA qui est à coller.
Si vous rencontrer un problème lors du chargement, n'hésiter pas à me prévenir.
Encore merci pour tous,
Laurent