Discussion :

[Superpat9999]

Bonjour
J'ai 2 onglets dans un classeur Excel : "Money" et "Ecriture".
Dans "Ecriture" sur la colonne A, j'ai 6 données :



Je souhaite que ma réference se fasse sur les lignes 1 à 5
Dans "Money", je souhaite trouver la ligne 16, sachant qu'il peut y avoir plusieurs dates identiques, la recherche se faisant sur une cinquantaine de lignes :



Merci de votre aide

[Thautheme]

Bonjour Binns, bonjour le forum,

Essaie comme ça :

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 Macro2()
Dim E As Worksheet 'déclare la variable E (onglet Écriture)
Dim M As Worksheet 'déclare la variable M (onglet Money)
Dim TV As Variant 'déclare la variable TV (Tableau ds Valeurs)
Dim DE As Date 'déclare la variable DE (Date Écriture)
Dim L As String 'déclare la variable L (Libellé)
Dim P As String 'déclare la variable P (Payement)
Dim V As Double 'déclare la variable V (Valeur)
Dim DM As Date 'déclare la variable DM (Daye Money)
Dim Li As Integer
 
Set M = Worksheets("Money") 'définit l'onglet M
Set E = Worksheets("Écriture") 'définit l'onglet E
DE = DateSerial(Year(E.Range("A1").Value), Month(E.Range("A1").Value), Day(E.Range("A1").Value)) 'définit la date DE
L = E.Range("A2").Value 'définit le libellé L
P = E.Range("A3").Value 'définit le payement P
V = E.Range("A4").Value 'définit la valeur V
TV = M.Range("A10").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    DM = DateSerial(Year(TV(I, 1)), Month(TV(I, 1)), Day(TV(I, 1))) 'définit la date DM
    'si les données corresponde, définit la ligne LI (= I + 9 car le tableau commence à la ligne 10), sort de la boucle
    If DM = DE And TV(I, 2) = L And TV(I, 3) = P And IIf(TV(I, 4) <> "", TV(I, 4) = V, TV(I, 5) = V) Then Li = I + 9: Exit For
Next I 'prochaine boucle de la ligne
If Li = 0 Then MsgBox "Données non trouvées !": Exit Sub 'si aucune correspondance, message, sort de la procédure
M.Activate 'active l'onglet M
M.Rows(Li).Select 'sélectionne la ligne LI de l'onglet M
End Sub

Attention ! dans le Payement il y a des espaces. Il faut qu'il y en ai autant dans les deux onglets...

[Superpat9999]

Merci beaucoup Thautheme,
C'est parfait, tout fonctionne correctement.

[Superpat9999]

Bonjour,
Thautheme, j'ai légèrement modifié ton code car il ne trouvait pas de correspondance lorsque la ligne débit était vide.

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Sub Compare1()
Dim E As Worksheet 'déclare la variable E (onglet Écriture)
Dim M As Worksheet 'déclare la variable M (onglet Money)
Dim TV As Variant 'déclare la variable TV (Tableau ds Valeurs)
Dim DE As Date 'déclare la variable DE (Date Écriture)
Dim L As String 'déclare la variable L (Libellé)
Dim P As String 'déclare la variable P (Payement)
Dim D As Double 'déclare la variable D (Valeur)
Dim C As Double 'déclare la variable C (Valeur)
Dim DM As Date 'déclare la variable DM (Daye Money)
Dim Li As Integer
Dim i As Integer
Dim Rng As Range
Dim FinLig As Integer
Set M = Worksheets("Money") 'définit l'onglet M
Set E = Worksheets("Écriture") 'définit l'onglet E
 
DE = DateSerial(Year(E.Range("A1").Value), Day(E.Range("A1").Value), Month(E.Range("A1").Value)) 'définit la date DE inversé
L = E.Range("A2").Value 'définit le libellé L
P = E.Range("A3").Value 'définit le payement P
D = E.Range("A4").Value 'définit la valeur D
C = E.Range("A5").Value 'définit la valeur C
TV = M.Range("A10").CurrentRegion 'définit le tableau des valeurs TV
 
For i = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    DM = DateSerial(Year(TV(i, 1)), Month(TV(i, 1)), Day(TV(i, 1))) 'définit la date DM
    'si les données correspondent, définit la ligne LI (= I + 9 car le tableau commence à la ligne 10), sort de la boucle
    'si V est pas vide
    If TV(i, 4) <> "" Then
    If DM = DE And TV(i, 2) = L And TV(i, 3) = P And IIf(TV(i, 4) <> "", TV(i, 4) = D, TV(i, 5) = D) Then Li = i + 9: Exit For
    Else
    If DM = DE And TV(i, 2) = L And TV(i, 3) = P And IIf(TV(i, 5) <> "", TV(i, 5) = C, TV(i, 6) = C) Then Li = i + 9: Exit For
    End If
Next i 'prochaine boucle de la ligne
If Li = 0 Then MsgBox "Données non trouvées !": Exit Sub 'si aucune correspondance, message, sort de la procédure
M.Activate 'active l'onglet M
M.Rows(Li).Select 'sélectionne la ligne LI de l'onglet M
Range("A" & Li).Select
If ActiveCell.Row = "11" Then
    Debug.Print ActiveCell.Row
    Debug.Print "Première ligne, Aucune nouvelle rentrée, fin du programme"
    MsgBox "Aucune nouvelle rentrée, fin du programme"
    End
Else
    Debug.Print ActiveCell.Row
    MsgBox "Trouvé, autre ligne, on supprime : " & ActiveCell.Row
End If
End Sub

Maintenant, il reste un problème avec :

C'est sur la date, car le fichier "Ecriture" provient d'un fichier Texte, un extrait ci-dessous

Code :

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

1
2
3
4
    For Colonne = 1 To 6                        '// boucle sur les colonnes
        str = Cells(Ligne, Colonne)
        Print #iFile, str                       '// écrire dans le fichier
    Next Colonne

Fichier Ecriture :


Si je remplace :

Code :

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

1
2
DE = DateSerial(Year(E.Range("A1").Value), Day(E.Range("A1").Value), Month(E.Range("A1").Value)) 'définit la date DE inversé
'DE = DateSerial(Year(E.Range("A1").Value), Month(E.Range("A1").Value), Day(E.Range("A1").Value)) 'définit la date DE Thautheme

Le première ligne est trouvée, mais pas les autres. Si je laisse votre code, les autres sont trouvées mais pas la première.

Merci de me dépanner une fois encore... Je trouve le code très "Elégant" !

[Thautheme]

Re,

Pour le premier point le problème ne venait pas du fait que la colonne Débit soit vide (car c'était pris en compte avec le IIf), mais du fait que la valeur dans Écriture est numérique tandis que dans Money c'est du texte (avec le point comme séparateur décimal), J'ai modifié le code et ça semble marcher correctement.
Quant au second point la syntaxe de DateSerial ne peut pas être modfidiée c'est toujours : DateSerial(Year(une_date), Month(une_date), Day(une_date). J'ai utilisé exprès DateSerial pour éviter les inversions jour/mois. Aussi je ne comprends pas ce que tu veux dire par : Le première ligne est trouvée, mais pas les autres. Si je laisse votre code, les autres sont trouvées mais pas la première.

Essaie ce nouveau code :

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
Sub Compare()
Dim M As Worksheet 'déclare la variable M (onglet Money)
Dim E As Worksheet 'déclare la variable E (onglet Écriture)
Dim DE As Date 'déclare la variable DE (Date Écriture)
Dim L As String 'déclare la variable L (Libellé)
Dim P As String 'déclare la variable P (Payement)
Dim VT As String  'déclare la variable VT (Valeur en Texte)
Dim TV As Variant 'déclare la variable TV (Tableau ds Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim DM As Date 'déclare la variable DM (Date Money)
Dim LI As Integer 'déclare la variable LI (LIgne)
 
Set M = Worksheets("Money") 'définit l'onglet M
Set E = Worksheets("Écriture") 'définit l'onglet E
DE = DateSerial(Year(E.Range("A1").Value), Month(E.Range("A1").Value), Day(E.Range("A1").Value)) 'définit la date DE
L = E.Range("A2").Value 'définit le libellé L
P = E.Range("A3").Value 'définit le payement P
VT = Replace(E.Range("A4").Value, ",", ".") 'définit la valeur VT (texte avec le point comme séparateur décimal
TV = M.Range("A10").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    DM = DateSerial(Year(TV(I, 1)), Month(TV(I, 1)), Day(TV(I, 1))) 'définit la date DM
    'si les données correspondent, définit la ligne LI (= I + 9 car le tableau commence à la ligne 10), sort de la boucle
    'le IIf fait que si la colonne "Débit" est vide, c'est la colonne "Crédit' qui est prise en compte
    If DM = DE And TV(I, 2) = L And TV(I, 3) = P And IIf(TV(I, 4) <> "", TV(I, 4) = VT, TV(I, 5) = VT) Then LI = I + 9: Exit For
Next I 'prochaine boucle de la ligne
If LI = 0 Then MsgBox "Données non trouvées !": Exit Sub 'si aucune correspondance, message, sort de la procédure
M.Activate 'active l'onglet M
M.Rows(LI).Select 'sélectionne la ligne LI de l'onglet M
End Sub

[Superpat9999]

Bonsoir Thautheme,
Merci de prendre le temps de me répondre.
Dans ta dernière macro, plus rien n'est trouvé !
La mienne fonctionne à moitié, je pense que le fait que l'onglet écriture soit inscrit depuis un fichier texte, appelé avec Line Input ramène une date au format US, ce qui fait que cela peut fonctionner certaines fois et pas d'autres.
Sur ta 1ère macro, j'ai essayé 5 dates, les 4 premières passent et la 5ème ne trouve rien.
14/08/2019
14/08/2019
13/08/2019
13/08/2019
12/08/2019, ici on ne trouve rien car écriture me marque 08/12/2019.
Bien que le fichier texte m'indique :
12/08/2019
Le passage se fait donc mal.

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
33
34
Sub Lire_Fichier_Texte()
    ' Utilisation de la commande LINE INPUT qui lit une ligne au complet
    ' Problème de réécriture sur la date,
    Dim I As Long, ar
    Dim sRepertoire As String, sNomFichier As String
    Dim iFile As Integer
    Dim Data As String
    Dim Entier As Integer
    Dim Res As Integer
    Dim ws As Worksheet
    Dim Pos As Integer
    Dim Strlen As Integer
 
    sRepertoire = "D:\Dropbox\Money\" '// doit terminer avec un "\"
    sNomFichier = "MonMoney.txt" '// nom du fichier
 
        Set ws = Sheets("Écriture") '// feuille où écrire les résultats
        ws.UsedRange.Clear '// vider le contenu de la feuille
        Set E = Worksheets("Écriture") 'définit l'onglet E
        E.Activate 'active l'onglet M
        'Ouvrir le 1er fichier
        iFile = FreeFile
        Open sRepertoire & sNomFichier For Input As #iFile
 
        'Lecture du fichier et écriture dans Excel
        I = 1
        Do Until EOF(iFile)
 
            Line Input #iFile, Data
            ws.Cells(I, 1) = Data
            I = I + 1
        Loop
    Close #iFile '// Fermer le fichier
End Sub