Problème de codage sur VBA

**MarcelG** · 14/12/2018, 11h49

Salut,

Il te faut dès lors passer par un dictionnaire des compagnies attaché à chaque sinistre.
Si le compte de dictionnaire est > 1 alors la mention est portée.

Il doit y avoir plus sophistiqué. Mais l'esprit est là.

Ne pas oublier d'activer la référence "Microsoft Scripting Runtime" afin de bien déclarer le dictionnaire ee en faciliter la saisie des méthodes et propriétés.

A comprendre d'abord. Pas de copier/coller. Volontairement, je n'ai pas mis de commentaire.
A adapter ensuite.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
 
Public Sub essai_sin()
 
Dim dernl As Integer
Dim i As Integer, j As Integer
 
Dim dico As Scripting.Dictionary
 
Set dico = CreateObject("Scripting.Dictionary")
 
With Sheets("SUIVTRANS EN COURS")
        dernl = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To dernl
                For j = 2 To dernl
                        If .Cells(j, 10).Value = .Cells(i, 10).Value And Not dico.Exists(Cells(j, 8).Value) Then dico.Add .Cells(j, 8).Value, .Cells(j, 8).Value
                Next j
                If dico.Count > 1 Then .Cells(i, 10).Offset(0, 3).Value = "REGULARISATION CIE-TEMPLATE"
                dico.RemoveAll
        Next i
End With
 
Set dico = Nothing
 
End Sub

**BENNASR** · 14/12/2018, 11h50

Je me trompe dans mon interpretation du resultat d'un countif?

non non je demande simplement à notre ami OBADJ de tester le fichier
En colonne J les numéros de sinistres qui correspond à un numéro CIE en colonne H donc si ce numéro se répète encore une fois dans une nouvelle ligne vu qu'il a un autre numéro CIE ça veux dire :
Jamais le C qui compte le nombre des sinistre ne peut être supérieur à D qui compte le nombre des CIE
donc D soit égal soit inférieure à C

**OBADJ** · 14/12/2018, 11h56

Problème résolue merci beaucoup BENNASR BRAVO !

Merci a tous !

Pour mon prochain commentaire je voudrais : Pour le même numéro de sinistre si la sommes des montants est débiteur alors on mettra un commentaire en M "SOLDE CREDITEUR - A REMBOURSER"

Il est plus facile ce code !

**MarcelG** · 14/12/2018, 12h06

Vous me dîtes si je me trompe.
Ce développement est valable à la condition qu'une même compagnie ne règle pas 2 sinistres différents.
Dans ce cas....

**OBADJ** · 14/12/2018, 12h08

Par compte le code ne fonctionne pas sur mon fichier excel de plus de 6000 ligne dans je lance la macro elle m'affiche aucun commentaire....

Je comprends plus rien je suis perdu lol

**MarcelG** · 14/12/2018, 12h11

As-tu essayé le mien?

**unparia** · 14/12/2018, 12h21

Coucou
Il est vrai que le type integer a une limite, lui, nettement inférieure à celle du type long.

**MarcelG** · 14/12/2018, 12h34

Salut,
D'accord. -32768 à 32767.
La base de notre ami détient 6000 lignes.
J'ai déjà évoqué ce propos dans le forum.
Franchement, des bases de 40000 enregistrements ne devraient pas courir les rues.
Comme les codes proposés sont, dans leur grande majorité, à adapter, cette déclaration reste à la charge du receveur.
Ce qui pourrait d'ailleurs lui être profitable.

(Au passage, les fonctions déclarées en type (variables personnalisées) font désormais partie de ma documentation.

)

**OBADJ** · 14/12/2018, 13h35

Envoyé par MarcelG

As-tu essayé le mien?

Oui, j'ai testé ton code sauf que ça m'affiche un message : "Erreur de compilation : Instruction incorrecte dans une procédure"

J'ai fais le copier/coler car j'ai aps trop compris ce que tu voulais faire et le fait "d'activer la référence "Microsoft Scripting Runtime" afin de bien déclarer le dictionnaire ee en faciliter la saisie des méthodes et propriétés", je ne sais pas le faire...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
 
Public Sub essai_sin()
 
Dim dernl As Integer
Dim i As Integer, j As Integer
 
Dim dico As Scripting.Dictionary
 
Set dico = CreateObject("Scripting.Dictionary")
 
With Sheets("SUIVTRANS EN COURS")
        dernl = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To dernl
                For j = 2 To dernl
                        If .Cells(j, 10).Value = .Cells(i, 10).Value And Not dico.Exists(Cells(j, 8).Value) Then dico.Add .Cells(j, 8).Value, .Cells(j, 8).Value
                Next j
                If dico.Count > 1 Then .Cells(i, 10).Offset(0, 3).Value = "REGULARISATION CIE-TEMPLATE"
                dico.RemoveAll
        Next i
End With
 
Set dico = Nothing
 
End Sub

Envoyé par unparia

Coucou
Il est vrai que le type integer a une limite, lui, nettement inférieure à celle du type long.

Tu peux nous aider pour le code stp ça ne marche pas...

**MarcelG** · 14/12/2018, 13h49

OBADJ,

Erreur de compilation : Instruction incorrecte dans une procédure

Je pense qu'il s'agit d'un problème de références.
Dans le menu VBE,
Outils\Références
Balayer la zone de liste et cocher "Microsoft Scripting RunTime"

Teste à nouveau.
Sur mon poste, le code est effectif.

**BENNASR** · 14/12/2018, 14h01

bonsoir à tous
Pour le code à votre disposition et comme a remarqué les amis du site et vu que tu as beaucoup de ligne
remplacer integer par long et nous dire si ça arrange le problème

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim dernl As Integer
Dim i As Integer
Dim C As Integer, D As Integer

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim dernl As long
Dim i As long
Dim C As long, D As long

**OBADJ** · 14/12/2018, 14h02

Envoyé par MarcelG

Toujours le même message qui s'affiche. J'ai copier/coller exactement ton code d'avant...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Macro3()
 
Option Explicit
 
Public Sub essai_sin()
 
Dim dernl As Integer
Dim i As Integer, j As Integer
 
Dim dico As Scripting.Dictionary
 
Set dico = CreateObject("Scripting.Dictionary")
 
With Sheets("SUIVTRANS EN COURS")
        dernl = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To dernl
                For j = 2 To dernl
                        If .Cells(j, 10).Value = .Cells(i, 10).Value And Not dico.Exists(Cells(j, 8).Value) Then dico.Add .Cells(j, 8).Value, .Cells(j, 8).Value
                Next j
                If dico.Count > 1 Then .Cells(i, 10).Offset(0, 3).Value = "REGULARISATION CIE-TEMPLATE"
                dico.RemoveAll
        Next i
End With
 
Set dico = Nothing
 
End Sub

Envoyé par BENNASR

ça ne fonctionne toujours pas voici le code que j'ai entré après ta modification :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Dim dernl As long
           Dim i As long
           Dim NUMSIN As String, CODECIE As String
            Dim C As long, D As long
With Sheets("SUIVTRANS EN COURS")
        dernl = .Range("A" & .Rows.Count).End(xlUp).Row
 
      .Range("M2:M" & dernl).ClearContents
 
 
        For i = 2 To dernl
                NUMSIN = .Cells(i, 10).Value
                CODECIE = .Cells(i, 8).Value
                C = WorksheetFunction.CountIf(.Range("J2:J" & dernl), NUMSIN)
                D = WorksheetFunction.CountIf(.Range("H2:H" & dernl), CODECIE)
                If C > D Then .Cells(i, 13).Value = "REGULARISATION CIE-TEMPLATE"
        Next i
End With
 
End Sub

**BENNASR** · 14/12/2018, 14h36

Aucun message d'erreur???
normalement ça doit fonctionner !!!
vérifiez bien le nom de ton onglet !!
si non après le With Sheets("SUIVTRANS EN COURS") , ajouter :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Activate

**OBADJ** · 14/12/2018, 14h50

Ça bloque ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

dernl = .Range("A" & .Rows.Count).End(xlUp).Row

Erreur 424 : " objet requis"

**BENNASR** · 14/12/2018, 14h57

bizarre !!! et si tu supprime les lignes et tu laisse que 10 ligne ça fonctionne??? faire ce test svp

**Tylert** · 14/12/2018, 15h01

Envoyé par OBADJ

Par compte le code ne fonctionne pas sur mon fichier excel de plus de 6000 ligne dans je lance la macro elle m'affiche aucun commentaire....

Je comprends plus rien je suis perdu lol

Est ce que tu as au moins essayé de débugger?
Tu t'arranges pour avoir un cas qui doit causer la génération d'un commentaire dans les premieres lignes, et tu regardes ce que te renvoie les fonctions...

**MarcelG** · 14/12/2018, 15h18

Et pour ce qui me concerne, des pistes sans réponse....

**OBADJ** · 14/12/2018, 15h18

Ca ne fonctionne pas on dirait qu'il comprends pas ce qu'on dit sur les 6000 lignes. En revanche le code qu'on avait fait sur les écart il marche très bien je comprends pas pourquoi il ne marche pas celui ci...

Voici le code des écart qui fonctionne très bien :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
''REGULARISATION ECART-TEMPLATE
Dim Tablo
Dim j As Long
Dim C As Integer
Application.ScreenUpdating = False
 
With Sheets("SUIVTRANS EN COURS")
j = .Range("A" & Rows.Count).End(xlUp).Row
.Range("M2:M" & j).ClearContents
For j = 2 To j
NUMSIN = .Cells(j, "J")
CODECIE = .Cells(j, "H")
C = WorksheetFunction.CountIf(.Range("J2:J" & .Range("A" & Rows.Count).End(xlUp).Row), NUMSIN)
D = WorksheetFunction.CountIf(.Range("H2:H" & .Range("A" & Rows.Count).End(xlUp).Row), CODECIE)
If C > D Then .Cells(j, "M") = "REGULARISATION CIE-TEMPLATE"
Next j
 
Tablo = .Range("J2", "K" & .Range("K" & .Rows.Count).End(xlUp).Row)
 For j = 2 To j - 1
 x = 0
   For i = LBound(Tablo, 1) To UBound(Tablo, 1)
             If .Cells(j, "j") = Tablo(i, 1) Then
               x = x + CDbl(Tablo(i, 2))
             End If
  Next i
  If x >= -10 And x <= 10 And x <> 0 Then .Cells(j, 13) = "REGULARISATION ECART-TEMPLATE"
  'Cells(j, "AA") = x
  'MsgBox x
  Next j
End With
Application.ScreenUpdating = True
End Sub