chercher et regrouper des valeur ce raprochent le plus

peygase

XLDnaute Nouveau
bonjour,

jai tésté plusieur formule et je ne trouve pas voici mon probleme!

Sur la feuil1! les colonnes ((AB) valeur x et y)) et ((DE) valeur X et Y))
Ces colonne on une longueur aléatoire comment trié (les chiffre de la colonne DE) de façon a ce que par exemple le chiffre 100 de la colonne DE ce retrouve en face de ( 99 ou 100 de la colonne AB)
 

peygase

XLDnaute Nouveau
Re : chercher et regrouper des valeur ce raprochent le plus

bonjour,

jai tésté plusieur formule et je ne trouve pas voici mon probleme!

Sur la feuil1! les colonnes ((AB) valeur x et y)) et ((DE) valeur X et Y))
Ces colonne on une longueur aléatoire comment trié (les chiffre de la colonne DE) de façon a ce que par exemple le chiffre 100 de la colonne DE ce retrouve en face de ( 99 ou 100 de la colonne AB)
 

Pièces jointes

  • construitdragon.xls
    46.5 KB · Affichages: 58

peygase

XLDnaute Nouveau
Re : chercher et regrouper des valeur ce raprochent le plus

je vien de refaire le tableau avec commentaire et resulta attendu

jai aussi un macro mé qui ne fonctione pas vraimeent

Public Sub trie()

Set F1 = Worksheets("Feuil1")

With F1

Nblig1 = .Cells(.Rows.Count, 1).End(xlUp).Row
Nblig2 = .Cells(.Rows.Count, 2).End(xlUp).Row
If Nblig1 >= Nblig2 Then
nblig = Nblig1
Else
nblig = Nblig2
End If
i = 0

Do

i = i + 1
Set a1 = .Cells(i, 1)
Set a2 = .Cells(i, 2)

If a1.Value < a2.Value Then
a2.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Else
If a1.Value > a2.Value Then
a1.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
End If

Loop Until (a1 = "" And a2 = "")


End With

End Sub
 

Pièces jointes

  • trie2.xls
    41 KB · Affichages: 62

peygase

XLDnaute Nouveau
Re : chercher et regrouper des valeur ce raprochent le plus

un macro qui fonctionne un peut mieux mé pas encore assé la je suis perdu

Public Sub trie()

Dim NbLig1, NbLig2, valOK As Integer

Set F1 = Worksheets("exemple1")

With F1

NbLig1 = .Cells(.Rows.Count, 1).End(xlUp).Row
NbLig2 = .Cells(.Rows.Count, 5).End(xlUp).Row

For i = 7 To NbLig1

valOK = 9999
posOK = 0
aa = .Cells(i, 1).Value
bb = .Cells(i, 2).Value

For j = i To NbLig2
' Formule qui permet de definir la priorité
valeur = (.Cells(j, 5).Value - aa) * 10 + (.Cells(j, 6).Value - bb)

If valeur < 0 Then
valeur = valeur * -1
End If
If valeur < valOK Then
valOK = valeur
posOK = j
End If
Next j

.Range("E" & posOK & ":G" & posOK).Copy
.Range("E" & i & ":G" & i).Insert Shift:=xlDown
.Range("E" & posOK + 1 & ":G" & posOK + 1).Delete Shift:=xlUp
.Range("H" & i).Value = .Range("C" & i).Value

Next i

End With

End Sub
00

Aujourd'hui, 17h34

personne?
 
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 276
Messages
2 086 714
Membres
103 378
dernier inscrit
phdrouart