Besoin d'aide pour une Macro Excel Rapprochement Données

[Abderrahmane]

Excel Downloads TEAM ;-)

J'ai besoin de votre aide pour un rapprochement, rechercher le détail d'un total (une valeur A) sur plusieurs cellule B
Propabilité d'une somme equivalente


Merci d'avance

 

[Paritec]

Re : Besoin d'aide pour une Macro Excel Rapprochement Données

Bonjour Abderahmane le forum
j'ai ouvert ton fichier et comme tu as tout bien expliqué ce que tu voulais bah j'ai refermé
j'ai pas de boule de cristal!! ( et je ne suis pas le seul)
bonne soirée
Papou

 

[job75]

Re : Besoin d'aide pour une Macro Excel Rapprochement Données

Bonjour Abderrahmane, salut Pascal,

Pascal, il s'agit bien sûr d'un rapprochement comptable.

Il me semble que Ti avait fait une macro sur cette question.

En voici une de mon cru qui utilise des tirages aléatoires :

Sub Rapprochement()
Dim tablo1, tablo2, ub&, i&, n&, s#, j&, r As Byte
[E3:E65536].ClearContents
tablo1 = Range("D3:E" & [D3].End(xlDown).Row)
tablo2 = Range("F3:G" & [F3].End(xlDown).Row)
ub = UBound(tablo1)
For i = 1 To UBound(tablo2)
  n = 0
1 s = 0
  For j = 1 To ub
    If tablo1(j, 2) = tablo2(i, 2) Then tablo1(j, 2) = ""
  Next
  For j = 1 To ub
    If tablo1(j, 2) = "" Then
      r = Int(2 * Rnd)
      If r Then tablo1(j, 2) = tablo2(i, 2)
      s = s + r * tablo1(j, 1)
    End If
  Next
  If s <> tablo2(i, 1) Then
    n = n + 1
    If n < 100000 Then GoTo 1
    MsgBox "Rapprochement non réussi..."
    Exit Sub
  End If
Next
[D3].Resize(ub, 2) = tablo1
End Sub

Elle est dans Module1 (Alt+F11) et lancée par un clic sur le bouton.

Fichier joint.

A+

 

[job75]

Re : Besoin d'aide pour une Macro Excel Rapprochement Données

Re,

Cette macro est plus rapide dans la manipulation du nombre aléatoire Rnd :

Sub Rapprochement()
Dim tablo1, tablo2, ub&, i&, n&, s#, j&
[E3:E65536].ClearContents
tablo1 = Range("D3:E" & [D3].End(xlDown).Row)
tablo2 = Range("F3:G" & [F3].End(xlDown).Row)
ub = UBound(tablo1)
For i = 1 To UBound(tablo2)
  n = 0
1 s = 0
  For j = 1 To ub
    If tablo1(j, 2) = tablo2(i, 2) Then tablo1(j, 2) = ""
  Next
  For j = 1 To ub
    If tablo1(j, 2) = "" Then
      If Rnd > 0.5 Then
        tablo1(j, 2) = tablo2(i, 2)
        s = s + tablo1(j, 1)
      End If
    End If
  Next
  If s <> tablo2(i, 1) Then
    n = n + 1
    If n < 100000 Then GoTo 1
    MsgBox "Rapprochement non réussi..."
    Exit Sub
  End If
Next
[D3].Resize(ub, 2) = tablo1
End Sub

Fichier (2).

A+

 

[Abderrahmane]

Re : Besoin d'aide pour une Macro Excel Rapprochement Données

@ Paritec : Merci pour tous ;-)

@ job75 : BRAVOOOOOOO C'est manifique tu ma sauvé ;-)

 

[job75]

Re : Besoin d'aide pour une Macro Excel Rapprochement Données

Bonjour Abderrahmane, le forum,

Coloration de la cellule en colonne F quand le rapprochement ne se fait pas :

Sub Rapprochement()
Dim tablo1, tablo2, ub&, i&, n&, s#, j&
[E3:E65536].ClearContents
[F3:F65536].Interior.ColorIndex = xlNone
tablo1 = Range("D3:E" & [D3].End(xlDown).Row)
tablo2 = Range("F3:G" & [F3].End(xlDown).Row)
ub = UBound(tablo1)
For i = 1 To UBound(tablo2)
  n = 0
1 s = 0
  For j = 1 To ub
    If tablo1(j, 2) = tablo2(i, 2) Then tablo1(j, 2) = ""
    If tablo1(j, 2) = "" Then
      If Rnd > 0.5 Then
        tablo1(j, 2) = tablo2(i, 2)
        s = s + tablo1(j, 1)
      End If
    End If
  Next
  If s <> tablo2(i, 1) Then
    n = n + 1
    If n < 100000 Then GoTo 1
    For j = 1 To ub
      If tablo1(j, 2) = tablo2(i, 2) Then tablo1(j, 2) = ""
    Next
    [F2].Offset(i).Interior.ColorIndex = 46 'coloration
    MsgBox [F2].Offset(i).Address(0, 0) & " pas de rapprochement..."
  End If
Next
[D3].Resize(ub, 2) = tablo1
End Sub

Fichier (3).

A+

 

[job75]

Re : Besoin d'aide pour une Macro Excel Rapprochement Données

Bonjour Abderrahmane, le forum,

Il faut bien voir que la solution proposée ne fonctionne pas toujours.

C'est le cas quand il y a plusieurs solutions possibles pour une même valeur B.

Voir le fichier Test template(3) joint.

Il faut alors sortir l'artillerie lourde et faire un rapprochement global et non pas valeur par valeur.

Voir le fichier Rapprochement global(1) avec les formules en E3 F3 I10 et cette macro :

Sub Rapprochement()
Dim i&
Application.ScreenUpdating = False
[Tirage].Calculate
For i = 1 To 1000000
If [Test] Then [Tirage].Calculate Else Exit Sub
Next
MsgBox "Le rapprochement a échoué..."
End Sub

Mais le nombre de combinaisons possibles augmente très vite, et même avec 6 valeurs ça peut être assez long...

A+

 

[job75]

Re : Besoin d'aide pour une Macro Excel Rapprochement Données

Re,

On gagne beaucoup de temps avec cette formule en I12 (Test) :

=SOMMEPROD(N(NB.SI(ValeurB1;ValeurB1)<>NB.SI(ValeurB1;ValeurB2)))

Les "Valeur B2" ne se retrouvent pas dans le même ordre que les "Valeur B1", mais ça n'a pas vraiment d'importance.

Fichier (2).

Edit : légèrement modifié les définitions des noms (en cas d'insertion ou suppression de la 1ère ligne).

A+

 

[job75]

Re : Besoin d'aide pour une Macro Excel Rapprochement Données

Re,

Une autre solution, qui devrait être encore plus rapide, avec cette fonction personnalisée :

Function DIFFERE(plage1, plage2) As Boolean
Dim t, t1, t2, n1&, n2&
plage1 = plage1: plage2 = plage2 'matrices (plus rapides)
For Each t In plage1
  If IsError(Application.Match(t, plage2, 0)) Then DIFFERE = True: Exit Function
  n1 = 0: n2 = 0
  For Each t1 In plage1
    If t1 = t Then n1 = n1 + 1
  Next
  For Each t2 In plage2
    If t2 = t Then n2 = n2 + 1
  Next
  If n1 <> n2 Then DIFFERE = True: Exit Function
Next
End Function

Elle est utilisée en I12 pour le test.

Fichier (3).

A+