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 49 50 51 52 53 54 55 56 57 58 59 60
| Sub RechMAJModification()
'Toujours mettre au moins une majuscule dans les noms de variables, ca permet de repérer les fautes de frappe dans le code
'il faut répeter les type des variables à chaque fois, sinon VB déclare des variants
Dim Plage6 As Range, ChercheIni As Range, Cherch As Range, Cherch2 As Range, Cell As Range
Dim i As Integer, j As Integer, l As Integer, k As Integer, m As Integer, n As Integer, o As Integer
'
Dim SheetRelation As Worksheet
'Il est préférable de faire référence à un onglet en précisant dans quel classeur il se trouve
'L'utilisation de variable worksheet alége ensuite le code
Set SheetRelation = ThisWorkbook.Sheets("TableRelation")
j = 0
k = 1
l = SheetRelation.Cells(Rows.Count, "A").End(xlUp).Row
'
'
'
With ThisWorkbook.Sheets("Périmètre")
Set Plage6 = .Range("N3", .Cells(.Rows.Count, "I").End(xlUp).Offset(0, 5)) 'la colonne N est vide?
End With
''MsgBox (plage6.Address)
'Attention a l'orthographe des variables "cherchEini"
Set ChercheIni = Plage6.Find("1", LookIn:=xlValues, SearchDirection:=xlNext)
'
If Not ChercheIni Is Nothing Then
With ThisWorkbook.Sheets("vba2")
' 'MsgBox (cherchini.Offset(0, -5).Value)
.Range("A1").Value = ChercheIni.Offset(0, -5).Value
While n <> 0 '"0" n est de type integer pas de type string
j = j + 1
'i = 0
For i = 0 To l
n = Application.CountA(.Range(.Cells(j, "A"), .Cells(j, .Columns.Count).End(xlToLeft)))
o = Application.CountA(.Range(.Cells(j + 1, "A"), .Cells(j + 1, .Columns.Count).End(xlToLeft)))
For m = 1 To n
Set Cherch = SheetRelation.Range(SheetRelation.Cells(i, 1), SheetRelation.Cells(l, 1)).Find(.Cells(j, m).Value, LookIn:=xlValues, SearchDirection:=xlNext)
If Not Cherch Is Nothing Then
k = Cherch.Row
Set Cherch2 = .Range(Sheets("vba2").Cells(j + 1, 1), .Cells(j + 1, 1000)).Find(SheetRelation.Range(cel(k)).Value, LookIn:=xlValues, SearchDirection:=xlNext)
If Cherch2 Is Nothing Then
.Cells(j + 1, o + 1) = SheetRelation.Range(cel(k)).Value
End If
End If
Next m
Next i
Wend
End With
'End If
'
'MAJModification
'
'Sheets("vba2").Cells.Clear
'
'plage6.Clear
'
End Sub |
Partager