Problème de codage sur VBA

Version imprimable

Voir 40 message(s) de cette discussion en une page

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:

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

14/12/2018, 11h50
BENNASR

Citation:

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
14/12/2018, 11h56
OBADJ

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 !
14/12/2018, 12h06
MarcelG

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....
14/12/2018, 12h08
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
14/12/2018, 12h11
MarcelG

As-tu essayé le mien?
14/12/2018, 12h21
unparia

Coucou
Il est vrai que le type integer a une limite, lui, nettement inférieure à celle du type long. ;)
14/12/2018, 12h34
MarcelG

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.:))

Citation:

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:

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
Citation:

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...

14/12/2018, 13h49
MarcelG

OBADJ,

Citation:

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.
14/12/2018, 14h01
BENNASR
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:

1 2 3 Dim dernl As Integer Dim i As Integer Dim C As Integer, D As Integer
par
Code:

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

Citation:

Envoyé par MarcelG

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

Code:

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

Citation:

Envoyé par BENNASR

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

Code:

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

14/12/2018, 14h36
BENNASR

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:

.Activate
14/12/2018, 14h50
OBADJ

Ça bloque ici :

Code:

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

Citation:

Erreur 424 : " objet requis"
14/12/2018, 14h57
BENNASR

bizarre !!! et si tu supprime les lignes et tu laisse que 10 ligne ça fonctionne??? faire ce test svp
14/12/2018, 15h01
Tylert

Citation:

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...
14/12/2018, 15h18
MarcelG

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

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:

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

14/12/2018, 15h19
OBADJ

Citation:

Envoyé par MarcelG

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

Marcel ca ne marche pas ton code ... :(
14/12/2018, 15h23
BENNASR

est ce que si tu réduit ton fichier de 10 lignes fonctionne??? je pense pas !!! testez ou envoyer ce fichier pour cerner le problème

Voir 40 message(s) de cette discussion en une page