Discussion :

[jslpfasc2]

Bonjour,

Je cherche à automatiser une recherche verticale sur VBA. Elle est d'ailleurs assez simple mais je débute alors je suis un peu paumé.
J'ai deux colonnes côte à côte, sur une même feuille. Je cherche à observer la première valeur de la première colonne, et parcourir toute la deuxième colonne. Si elle est dedans on inscrit dans une quatrième colonne "OK", sinon, on passe à la deuxième ligne de la première colonne, et ceci jusqu'à la fin de la colonne.

Sur ma feuille la colonne de référence est la deuxième, celle où chercher est la troisième, et celle où inscrire le OK est la quatrième.

Il faut savoir que je veux l'automatiser pour l'effectuer mensuellement, donc que la taille des colonnes va varier.

Voici ce que j'ai fait :

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
Dim line0 As Integer
Dim line1 As Integer
Dim cell_test0 As String
Dim cell_test1 As String
 
 
Sub line0_count()
Sheets("Swaps Liés Oblig AP").Select
line0 = -1
    Do
    line0 = line0 + 1
    cell_test0 = Cells(1 + line0, 3)
    Loop Until cell_test0 = ""
End Sub
 
Sub line1_count()
Sheets("Swaps Liés Oblig AP").Select
line1 = -1
    Do
    line1 = line1 + 1
    cell_test1 = Cells(1 + line1, 2)
    Loop Until cell_test1 = ""
End Sub
 
Sub recherche()
Sheets("Swaps Liés Oblig AP").Select
 
Dim i As Integer
Dim j As Integer
 
For i = 1 To line1
    For j = 1 To line0
    If Cells(i + 1, 2) = Cells(j + 1, 3) Then
    Cells(i + 1, 4) = "OK"
    End If
    Next j
Next i
End Sub

Ce code lance la macro, mais cette dernière inscrit des OK partout. (Alors qu'il y a clairement des cases de la colonne reférente qui sont pas dans la colonne à observer.) Sauriez-vous où se trouve le problème? Je tourne en rond...

Merci beaucoup!

[Daniel.C]

Bonjour,

Essaie :

Code :

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

1
2
3
4
5
6
7
8
Sub Recherche()
    Dim C As Range, I As Long
    For Each C In Range([A1], Cells(Rows.Count, 1).End(xlUp))
        For I = 1 To Cells(Rows.Count, 2).End(xlUp).Row
            If Cells(I, 2) = C.Value Then Cells(I, 4).Value = "OK"
        Next I
    Next C
End Sub

[Invité]

Salut,

Une variante si la colonne "B" ne contient pas de formules:

Code :

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

1
2
3
4
5
6
7
8
Option Explicit
 
Private Sub Recherche()
  Dim cel As Range
  For Each cel In Columns("B").SpecialCells(xlCellTypeConstants, 23).Cells
    If Not Columns("C").Find(cel.Value, , , xlWhole) Is Nothing Then Cells(cel.Row, "D") = "OK"
  Next cel
End Sub

[Daniel.C]

Pour les cellules vides :

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Recherche()
    Dim C As Range, I As Long
    For Each C In Range([A1], Cells(Rows.Count, 1).End(xlUp))
        If C.Value <> "" Then
            For I = 1 To Cells(Rows.Count, 2).End(xlUp).Row
                If Cells(I, 2) = C.Value Then Cells(I, 4).Value = "OK"
            Next I
        End If
    Next C
End Sub

[jslpfasc2]

Ça marche! Merci beaucoup à vous deux.

[patricktoulon]

Bonjour
si le nombre de ligne a tester est assez long boucler sur les cellules peut vite devenir un boulet pour la becane

boucler sur un tableau est beaucoup plus rapide
principe :
un tableau =ta plage
boucle sur toute les lignes du tableau
tester la col1 et col2 du tableau si oui col4 ="ok"
retranscription du tableau complet
tout simplement

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
 
Sub recherche_encore_plus_rapide_V()
'contexte general; tester la la colonne 1 et 2 si identique meme ligne colonne 4 =OK
    Dim tablo_general As Variant, Nblignes As Long, I As Long    ' déclaration des variables utile
    With Sheets(1)    'non ou index du sheets a adapter
        tablo_general = .Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row)    'integration de la grille excel dans la variable tableau
        For I = LBound(tablo_general) To UBound(tablo_general)    'boucle sur les ligne du tableau
            If tablo_general(I, 1) & tablo_general(I, 2) <> "" Then    'teste si les veleurs sont nules
                If tablo_general(I, 1) = tablo_general(I, 2) Then tablo_general(I, 4) = "ok"    'teste si la valeur colonne 1 et colonne2 sont identiquesi oui meme ligne colonne 4 = ok
            End If
        Next
        'retranscription complete du tableau dans la meme plage
       .Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row) = tablo_general
    End With
End Sub

Au plaisir