Discussion :

[L'Harrifette]

Bonjour,
Je voudrais savoir si excel peut identifier sous forme graphique les données absentes dans une liste de données. Les données sont identifiées par une lettre (ou un mot) plus un nombre (allant de 0 à 9999). Je vous joint un exemple.
J'ai pour ma part déjà une solution avec des formules dans les cases mais des que je dépasse une centaine de variable cela prend un temps fou. Je ne suis pas très "VBA" et je voudrais un avis pour savoir si cette solution serait mieux adaptée ?
Cordialement

[arosec]

Bonjour,

A priori, pas de problème de perf en vba...

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
49
50
51
52
53
54
 
Sub test()
Dim vSheetData As Worksheet
Dim vSheetErr As Worksheet
Dim r As Long
Dim s As String
Dim c As String
Dim n As String
Dim cpt As Long
Dim nerr As Long
 
On Error GoTo lblErr
 
Application.ScreenUpdating = False
 
Set vSheetData = ThisWorkbook.Worksheets("Donnée")
Set vSheetErr = ThisWorkbook.Worksheets("graphe A")
 
r = 1
 
cpt = 0
nerr = 0
 
While vSheetData.Cells(r, 1) > ""
  s = vSheetData.Cells(r, 1)
  c = Mid(s, 1, 1)
  n = Mid(s, 2, Len(s))
 
  If Not IsNumeric(n) Then
    'Debug.Print "Valeur non numérique en ligne " & r
    MsgBox "Valeur non numérique en ligne " & r, vbExclamation, "Erreur"
    Exit Sub
  End If
 
  While cpt < n
    'Debug.Print "Manque " & c & cpt
    nerr = nerr + 1
    vSheetErr.Cells(nerr, 1) = c & cpt
    cpt = cpt + 1
  Wend
 
  cpt = cpt + 1
  r = r + 1
Wend
 
GoTo lblFin
lblErr:
  MsgBox Err.Description
lblFin:
Set vSheetErr = Nothing
Set vSheetData = Nothing
 
Application.ScreenUpdating = True
End Sub

[L'Harrifette]

Bonjour et Merci pour votre macro qui m'a bien aidée à résoudre mon problème

Voici de résultat (pardon d'avance pour la mise en forme)

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
49
50
51
52
53
54
55
56
57
58
59
60
Sub test01()
Dim Feuil_D As Worksheet
Dim Feuil_R As Worksheet
Dim Donnee As String
Dim Initial As String
Dim Nbrs, Nbrs_PE, Nbrs_PD As String
Dim Large_T, Large_Tp As String
Dim cpt As Long
Dim nerr As Long
Dim Lig_Lec As Long
Dim Idx_Col_E, Idx_Lig_E As Long
 
On Error GoTo lblErr
 
Application.ScreenUpdating = False
 
Set Feuil_D = ThisWorkbook.Worksheets("Donnée")
Set Feuil_R = ThisWorkbook.Worksheets("graphe A")
 
Lig_Lec = 1
cpt = 0
nerr = 0
Col = 2
Idx_Lig_E = 2
Idx_Col_E = 2
Large_T = 10: Large_Tp = Large_T + 1
 
'Boucle traitement des données
While Feuil_D.Cells(Lig_Lec, 1) > ""
    'Exctration de la donnée de la ligne "
    Donnee = Feuil_D.Cells(Lig_Lec, 1)  'Donnee
    Initial = Mid(Donnee, 1, 1)         'Initial
    Nbrs = Mid(Donnee, 2, Len(Donnee))  'Nbrs
 
    'Test si "Donnée non numérique en ligne "
    If Not IsNumeric(Nbrs) Then
    'Debug.Print "Donnée non numérique en ligne " & Lig_Lec
    MsgBox "Valeur non numérique en ligne " & Lig_Lec, vbExclamation, "Erreur"
    Exit Sub
    End If
 
    Nbrs_PE = Int(Nbrs / Large_T)
    Nbrs_PD = Nbrs - (Nbrs_PE * Large_T)
    Idx_Lig_E = Nbrs_PE + 2
    Idx_Col_E = Nbrs_PD + 2
 
    Feuil_R.Cells(Idx_Lig_E, Idx_Col_E) = Initial & Nbrs
    Lig_Lec = Lig_Lec + 1
 
Wend
 
GoTo lblFin
lblErr:
  MsgBox Err.Description
lblFin:
Set Feuil_R = Nothing
Set Feuil_D = Nothing
 
Application.ScreenUpdating = True
End Sub

Cordialement