RECHERCHEV en VBA

Version imprimable

RECHERCHEV en VBA

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:

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

Bonjour,

Essaie :

Code:

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

Salut,

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

Code:

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

Pour les cellules vides :

Code:

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

11/03/2014, 14h55
jslpfasc2

Ça marche! Merci beaucoup à vous deux. :)

heu

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:

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