boucle de comparaison en vba excel

Version imprimable

Bonjour chers experts,
Dans un fichier Excel j’ai deux feuille :
- Première feuille nommée « saisie BL » contenant les colonnes : n° de lot, quantité, emplacement
- Deuxième feuille nommée « état de stock » contenant les colonnes : n° de lot, quantité, emplacement
Je veux que Excel fasse une comparaison entre les colonnes n° de lot et emplacement de la feuille « saisie BL » et les colonnes n° de lot et emplacement de la feuille « état de stock » et lorsqu’il trouve une coïncidence dans la table « état de stock » il mis les cellules de coïncidence en jaune.
ci dessous mon code mais ça ne marche pas:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub plasticolor() Dim i As Integer Dim j As Integer Dim f As Integer Dim TabEtq() As String Sheets("Saisie BL").Activate For i = 1 To 30 ReDim Preserve TabEtq(i) TabEtq(i) = ActiveSheet.Cells(i + 2, 2).Value & Cells(i + 2, 3).Value Next i Sheets("Etat de stock").Activate For j = 1 To 100 For f = 1 To UBound(TabEtq()) If ActiveSheet.Cells(j + 1, 2).Value = TabEtq(f) And ActiveSheet.Cells(1 + j, 3).Value = TabEtq(f) Then ActiveSheet.Cells(1 + j, 3).Interior.ColorIndex = 6 End If Next f Next j End Sub
veuillez m'assister svp
merci d'avance

13/02/2012, 13h22
jfontaine

Bonjour,

Quand tu charges la variable TabEtq, tu concatènes 2 cellules.

Code:

TabEtq(i) = ActiveSheet.Cells(i + 2, 2).Value & Cells(i + 2, 3).Value

Par contre, dans la comparaison de la feuille "Etat de Stock", tu prends chaque cellules individuellement.

Code:

If ActiveSheet.Cells(j + 1, 2).Value = TabEtq(f) And ActiveSheet.Cells(1 + j, 3).Value = TabEtq(f) Then

Peut etre que comme cela ça fonctionnerait mieux

Code:

If ActiveSheet.Cells(j + 1, 2).Value & ActiveSheet.Cells(1 + j, 3).Value= TabEtq(f) Then

Bonjour,

essayes comme ça (non testé)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub plasticolor()
Dim i As Integer, derlg As Long
Dim TabEtq() As String
With Sheets("Saisie BL")
  derlg = .Range("B" & .Rows.Count).End(xlUp).Row
  ReDim Preserve TabEtq(1 To derlg)
  For i = 3 To derlg
    TabEtq(i - 2) = .Range("B" & i) & .Range("C" & i)
  Next i
End With
With Sheets("Etat de stock")
  derlg = .Range("B" & .Rows.Count).End(xlUp).Row
  For i = 1 To derlg
    If .Range("B" & i + 1) & .Range("C" & i + 1) = TabEtq(i) Then
      .Range("B" & i + 1, "C" & i + 1).Interior.ColorIndex = 6
      Sheets("Saisie BL").Range("B" & i + 2, "C" & i + 2).Interior.ColorIndex = 6
    End If
  Next i
End With
End Sub

Bonjour,
Version sans table

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
Sub plasticolor()
  With ThisWorkbook
   Dim sht1 As Worksheet: Set sht1 = .Worksheets("Saisie BL")
   Dim sht2 As Worksheet: Set sht2 = .Worksheets("Etat de stock")
  End With
  Dim rT1 As Long: Dim rT2 As Long
  For rT1 = 2 To EndOfRow(sht1)
   For rT2 = 2 To EndOfRow(sht2)
     If (sht1.Cells(rT1, 1) = sht2.Cells(rT2, 1)) And (sht1.Cells(rT1, 3) = sht2.Cells(rT2, 3)) Then
      sht2.Cells(rT2, 3).Interior.ColorIndex = 6
     End If
   Next rT2
  Next rT1
End Sub
Function EndOfRow(wSht As Worksheet, Optional wColumn As Single = 1) As Long
 With wSht: EndOfRow = .Cells(.Cells.Rows.Count, wColumn).End(xlUp).Row: End With
End Function

Version avec variables dimensionnées

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub CompareTabl()
 With ThisWorkbook
  Dim sht1 As Worksheet: Set sht1 = .Worksheets("Saisie BL")
  Dim sht2 As Worksheet: Set sht2 = .Worksheets("Etat de stock")
 End With
  Dim Tabl1() As Variant, Tabl2 As Variant
  Dim rT1 As Long: Dim rT2 As Long
  Tabl1 = sht1.Range("A1").CurrentRegion: Tabl2 = sht2.Range("A1").CurrentRegion:
  For rT1 = 2 To UBound(Tabl1)
   For rT2 = 2 To UBound(Tabl2)
     If (Tabl1(rT1, 1) = Tabl2(rT2, 1)) And (Tabl1(rT1, 3) = Tabl2(rT2, 3)) Then
      sht2.Cells(rT2, 1).Interior.ColorIndex = 6
      sht2.Cells(rT2, 3).Interior.ColorIndex = 6
     End If
   Next rT2
  Next rT1
End Sub