XL 2013 Extraire des Montants positifs et leurs inverse

golby

XLDnaute Nouveau
Bonjour

Je dispose d'un fichier sur excel (export de +10 000 lignes) contenant des montants positifs et leurs contraires.
Par exemple: Dans les lignes 8 ( -50 812 630 187)et 9 ( -50 812 630 187) comportent un même montant mais de signe contraire.
Et aussi la différence entre ces montants est égale à zéro.

Je souhaiterais extraire de ce fichier tous les montants de signe contraire et dont la différence est égale à zéro.
Comment procéder ?
Ci-joint le fichier TEST CHARGE.
 

Pièces jointes

  • TEST CHARGE.xlsx
    10.8 KB · Affichages: 10
Solution
@golby

tu m'as donné cette info en MP :

« En fait dans le fichier global certains montants ne se suivent pas. »

dans ce cas, mon 1er code VBA n'est plus valable, car il regardait uniquement 2 lignes qui se suivent ! ce qui était toujours le cas dans ton fichier exemple initial ; maint'nant, j'ai fait une autre version qui utilise la méthode des tableaux (c'est beaucoup plus rapide, même sur plusieurs milliers de lignes, alors si tu as par exemple un fichier de 800 000 lignes, ça ira très bien sauf que tu n'auras plus le temps de faire une pause pour aller prendre un café ! 😜) ; de plus, ma nouvelle version est plus souple car ça marche même pour 2 lignes de montants identiques...​

soan

XLDnaute Barbatruc
Inactif
Bonjour golby,

bienvenue sur le site XLD ! :)

j'ai mis une MFC (Mise en Forme Conditionnelle) pour colorier en jaune toute ligne
dont celle qui suit est de montant contraire ; ça donne ceci :​

Image.jpg


peut-être que ça te suffira de les détecter, et qu'il n'y aura pas besoin
de faire un copier/coller dans un nouvel onglet ? 🍀

soan
 

Pièces jointes

  • TEST CHARGE.xlsx
    11.2 KB · Affichages: 4

golby

XLDnaute Nouveau
Bonjour golby,

bienvenue sur le site XLD ! :)

j'ai mis une MFC (Mise en Forme Conditionnelle) pour colorier en jaune toute ligne
dont celle qui suit est de montant contraire ; ça donne ceci :​

Regarde la pièce jointe 1144781

peut-être que ça te suffira de les détecter, et qu'il n'y aura pas besoin
de faire un copier/coller dans un nouvel onglet ? 🍀

soan
Merci pour la proposition§
Sauf que je veux les copier-coller (montant positif et Inverse) sur un nouvel onglet.
 

TooFatBoy

XLDnaute Barbatruc
j'ai remarqué les deux signes négatifs, moi aussi ; le 2ème montant est sans doute un copier / coller du 1er montant, et @golby a tout simplement oublié d'enlever le signe moins ; dans le fichier, c'est ok : voir les cellules F8 et F9 sur l'image de mon post #4.
Je ne peux pas actuellement ouvrir le fichier, mais je suis bien sûr tout-à-fait d'accord avec toi pour les deux signes moins et le copier/coller. 👍

Et ce que je voulais aussi, et surtout, dire c'est que la différence entre deux nombres identiques mais de signes contraires ne saurait être égale à zéro !
C'est la somme qui est égale à la tête à Toto... 😉
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
@golby

voici une autre version du fichier. :)

* sur la 2ème feuille, y'a que les en-têtes de colonnes.

* va sur la 1ère feuille ; fais Ctrl e ➯ travail effectué.

attention : ma solution fonctionne uniquement si les 2 lignes
de montant contraire se suivent l'une sous l'autre !

si ça n'est PAS TOUJOURS LE CAS, il faudrait un autre code VBA !



code VBA de Module1 (23 lignes) :

VB:
Option Explicit

Sub CpyLigs()
  If ActiveSheet.Name <> "Charges" Then Exit Sub
  Dim m&, n&: m = Rows.Count
  n = Cells(m, 1).End(3).Row: If n < 3 Then Exit Sub
  Dim cel As Range, i&, j&, k&: Application.ScreenUpdating = 0
  With Worksheets("Lignes soldées")
    j = .Cells(m, 1).End(3).Row
    If j > 1 Then .Range("A2:F" & j).ClearContents
    j = 2
    For i = 2 To n
      k = i + 1
      If Cells(i, 6) = -Cells(k, 6) Then
        Cells(i, 1).Resize(2, 6).Copy
        .Cells(j, 1).PasteSpecial -4163
        i = i + 1: j = j + 2
      End If
    Next i
    Application.CutCopyMode = 0: .Select: [A1].Select
  End With
End Sub

soan
 

Pièces jointes

  • TEST CHARGE.xlsm
    21 KB · Affichages: 3
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
@golby

tu m'as donné cette info en MP :

« En fait dans le fichier global certains montants ne se suivent pas. »

dans ce cas, mon 1er code VBA n'est plus valable, car il regardait uniquement 2 lignes qui se suivent ! ce qui était toujours le cas dans ton fichier exemple initial ; maint'nant, j'ai fait une autre version qui utilise la méthode des tableaux (c'est beaucoup plus rapide, même sur plusieurs milliers de lignes, alors si tu as par exemple un fichier de 800 000 lignes, ça ira très bien sauf que tu n'auras plus le temps de faire une pause pour aller prendre un café ! 😜) ; de plus, ma nouvelle version est plus souple car ça marche même pour 2 lignes de montants identiques qui ne se suivent pas. :)

la méthode d'utilisation est identique, mais comme les données sont les mêmes, tu ne verras pas de différence tangible ! tu verras une différence nettement sensible uniquement sur tes vrais fichiers volumineux, et c'est là seulement que tu pourras juger réellement de l'efficacité de la nouvelle méthode.​



code VBA de Module1 (32 lignes) :

VB:
Option Explicit: Option Base 1

Sub CpyLigs()
  If ActiveSheet.Name <> "Charges" Then Exit Sub
  Dim m&, n&: m = Rows.Count
  n = Cells(m, 1).End(3).Row: If n < 3 Then Exit Sub
  Dim cel As Range, T1, T2, i&, j&, k&, c&
  With Worksheets("Lignes soldées")
    k = .Cells(m, 1).End(3).Row: Application.ScreenUpdating = 0
    If k > 1 Then .Range("A2:F" & k).ClearContents
    n = n - 1: T1 = [A2].Resize(n, 7): ReDim T2(n, 6): k = 1
    For i = 1 To n
      If T1(i, 7) = 0 Then
        For j = i + 1 To n
          If T1(j, 7) = 0 Then
            If T1(i, 6) = -T1(j, 6) Then
              For c = 1 To 6: T2(k, c) = T1(i, c): Next c
              T1(i, 7) = 1: k = k + 1
              For c = 1 To 6: T2(k, c) = T1(j, c): Next c
              T1(j, 7) = 1: k = k + 1
              Exit For
            End If
          End If
        Next j
      End If
    Next i
    .Select
    [A2].Resize(k - 1, 6) = Application.Index(T2, _
      Evaluate("Row(" & "1:" & n & ")"), [Column(A:F)])
  End With
End Sub

soan
 

Pièces jointes

  • TEST CHARGE.xlsm
    22 KB · Affichages: 2
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Je souhaiterais extraire de ce fichier tous les montants de signe contraire et dont la différence est égale à zéro.
Comment procéder ?
Est-ce que ça veut dire qu'il faut extraire tous les doublons en valeur absolue ?

En attendant une réponse, voici, en pièce jointe, une proposition.
 

Pièces jointes

  • TEST-CHARGE_(TooFatBoy-v1).xlsm
    20.6 KB · Affichages: 5
Dernière édition:

golby

XLDnaute Nouveau
@golby

tu m'as donné cette info en MP :

« En fait dans le fichier global certains montants ne se suivent pas. »

dans ce cas, mon 1er code VBA n'est plus valable, car il regardait uniquement 2 lignes qui se suivent ! ce qui était toujours le cas dans ton fichier exemple initial ; maint'nant, j'ai fait une autre version qui utilise la méthode des tableaux (c'est beaucoup plus rapide, même sur plusieurs milliers de lignes, alors si tu as par exemple un fichier de 800 000 lignes, ça ira très bien sauf que tu n'auras plus le temps de faire une pause pour aller prendre un café ! 😜) ; de plus, ma nouvelle version est plus souple car ça marche même pour 2 lignes de montants identiques qui ne se suivent pas. :)

la méthode d'utilisation est identique, mais comme les données sont les mêmes, tu ne verras pas de différence tangible ! tu verras une différence nettement sensible uniquement sur tes vrais fichiers volumineux, et c'est là seulement que tu pourras juger réellement de l'efficacité de la nouvelle méthode.​



code VBA de Module1 (32 lignes) :

VB:
Option Explicit: Option Base 1

Sub CpyLigs()
  If ActiveSheet.Name <> "Charges" Then Exit Sub
  Dim m&, n&: m = Rows.Count
  n = Cells(m, 1).End(3).Row: If n < 3 Then Exit Sub
  Dim cel As Range, T1, T2, i&, j&, k&, c&
  With Worksheets("Lignes soldées")
    k = .Cells(m, 1).End(3).Row: Application.ScreenUpdating = 0
    If k > 1 Then .Range("A2:F" & k).ClearContents
    n = n - 1: T1 = [A2].Resize(n, 7): ReDim T2(n, 6): k = 1
    For i = 1 To n
      If T1(i, 7) = 0 Then
        For j = i + 1 To n
          If T1(j, 7) = 0 Then
            If T1(i, 6) = -T1(j, 6) Then
              For c = 1 To 6: T2(k, c) = T1(i, c): Next c
              T1(i, 7) = 1: k = k + 1
              For c = 1 To 6: T2(k, c) = T1(j, c): Next c
              T1(j, 7) = 1: k = k + 1
              Exit For
            End If
          End If
        Next j
      End If
    Next i
    .Select
    [A2].Resize(k - 1, 6) = Application.Index(T2, _
      Evaluate("Row(" & "1:" & n & ")"), [Column(A:F)])
  End With
End Sub

soan
Bonjour Soan!
J'aimerai dire merci, car ce fichier répond parfaitement à mes attentes!
 

Statistiques des forums

Discussions
312 836
Messages
2 092 617
Membres
105 466
dernier inscrit
Jsquare