Correcteur de base de données
Bonjour à tous ,
J' ai pour mission de mettre en place une macro vba permettant de corriger les données d'un tableau par exemple l'utilisateur l’utilisateur doit rentrer dans une colonne le code : AL 03 sauf que celui –ci rentrera le code al 3 ou AL3 ou encore AL03(sans l’espace) ce qui est faux.
Ceci n'est qu'un exemple parmi tant d'autres ( ex :AN3 au lieu de AN 03...).
J'ai déja réfléchis à une solution mais elle ne gères pas toutes les erreurs et ne gère pas le fait que si le code rentrée est sous le bon format.
Je vous remercie par avance pour votre aide .
J e vous est remis ci-joint le code source et un extrait de la BDD.
bonjour,
le fichier n'est pas passé.
bonjour,
le fichier n'est pas passé.
Merci voici l'extrait en pièce jointe
bonjour,
le fichier ne contient pas les cas dont tu parles mais voici une proposition de solution (vba). correction des codes qui se trouvent en colonne A
Sub aargh()
dl = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To dl
Cells(i, 1) = formatcode(Cells(i, 1))
Next i
End Sub
Function formatcode(ByVal fcode)
If fcode = "" Then Exit Function
For i = 1 To 2
If Mid(fcode, i, 1) Like "[A-Za-z]" Then
lettres = lettres + Mid(fcode, i, 1)
Else
Exit For
End If
Next i
For i = Len(fcode) To Len(fcode) - 1 Step -1
If Mid(fcode, i, 1) Like "#" Then
chiffres = chiffres + Mid(fcode, i, 1)
Else
Exit For
End If
Next i
If lettres <> "" And chiffres <> "" Then
formatcode = UCase(lettres) & " " & Format(Val(chiffres), "00")
Else
formatcode = fcode
End If
End FunctionBonjour h2S04 ,
Je te remercie pour ton aide j'ai exécuté ta maccro elle ne fonctionne pas.
Aussi, je suis un novice en VBA pourrai tu m'expliquer en commentaire comment tu procèdes ?
J'ai avancé sur le sujet et mis en place une maccro pour corriger les erreurs .
Dans certains cas celle ci fonctionne mais je n'arrive pas avoir le résultat escompté (j.value au lieu du code d'erreur et bien d'autres).
Les codes erreurs AN ,AL et PB sont de la forme AN XX exemple AN 02 au lieu de AN 2 .
Pour les codes T il n' y a pas d'espace exemple T01 au lieu de T1.
Je vous remet le fichier test ci -joint et mon extrait de code .
Merci pour votre aide .
Option Explicit
Private Sub correction_erreur()
Dim myDataRng As Range
Dim myDataRng2 As Range
Dim i As Range
Dim j As Range
Dim Wkb As Workbook
Set myDataRng2 = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each j In myDataRng2
j.Value = UCase(j.Value)
'Ar = Split(j, sSeparateur)
If InStr(1, j.Value, "AL34") > 0 Then
j.Value = Replace(j.Value, "3", " 3")
Else
If InStr(1, j.Value, "ANN13") > 0 Then
j.Value = Replace(j.Value, "NN13", "N 13") 'correctioon enroupe
Else
If InStr(1, j.Value, "T1") > 0 Then
j.Value = Replace(j.Value, "1", "01")
Else
If InStr(1, j.Value, "T2") > 0 Then
j.Value = Replace("j.Value", "2", "02")
Else
If InStr(1, j.Value, "T3") > 0 Then
j.Value = Replace("j.Value", "3", "03")
Else
If InStr(1, j.Value, "T4") > 0 Then
j.Value = Replace(j.Value, "4", "04")
Else
If InStr(1, j.Value, "T5") > 0 Then
j.Value = Replace(j.Value, "5", "05")
Else
If InStr(1, j.Value, "T6") > 0 Then
j.Value = Replace(j.Value, "6", "06")
Else
If InStr(1, j.Value, "T7") > 0 Then
j.Value = Replace(j.Value, "7", "07")
Else
If InStr(1, j.Value, "T8") > 0 Then
j.Value = Replace(j.Value, "8", "08")
Else
If InStr(1, j.Value, "T9") > 0 Then
j.Value = Replace(j.Value, "9", "09")
Else
If InStr(1, j.Value, "AN") > 0 Then
j.Value = Replace(j.Value, "N", "N ")
Else
If InStr(1, j.Value, "AL") > 0 Then
j.Value = Replace(j.Value, "L", "L ")
Else
If InStr(1, j.Value, "AN1") > 0 Then
j.Value = Replace(j.Value, "N", "N 0")
Else
If InStr(1, j.Value, "AN2") > 0 Then
j.Value = Replace(j.Value, "N", "N 0")
Else
If InStr(1, j.Value, "AN3") > 0 Then
j.Value = Replace(j.Value, "N", "N 0")
Else
If InStr(1, j.Value, "AN4") > 0 Then
j.Value = Replace(j.Value, "N", "N 0")
Else
If InStr(1, j.Value, "AN5") > 0 Then
j.Value = Replace(j.Value, "N", "N 0")
Else
If InStr(1, j.Value, "AN6") > 0 Then
j.Value = Replace(j.Value, "N", "N 0")
Else
If InStr(1, j.Value, "AN7") > 0 Then
j.Value = Replace(j.Value, "N", "N 0")
Else
If InStr(1, j.Value, "AN8") > 0 Then
j.Value = Replace(j.Value, "N", "N 0")
Else
If InStr(1, j.Value, "AN9") > 0 Then
j.Value = Replace(j.Value, "N", "N 0")
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next j
End Sub
bonjour,
en effet un bug, pour lequel voici une correction
Sub aargh()
' on reformatte tous les codes en colonne 1
dl = Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne
For i = 2 To dl 'pour chaque ligne
Cells(i, 1) = formatcode(Cells(i, 1)) 'on reformatte le code
Next i
End Sub
Function formatcode(ByVal fcode)
'fonction de reformatage du code
If fcode = "" Then Exit Function 'code vide
'on examine les 2 premières positions du code
For i = 1 To 2
If Mid(fcode, i, 1) Like "[A-Za-z]" Then 'la position est une lettre
lettres = lettres + Mid(fcode, i, 1)
Else
Exit For 'la position n'est pas une lettre on quitte la boucle
End If
Next i
'ici lettres contient 0, 1 ou 2 caractères alphabétiques
' on examine les 2 dernières positions du code en partant de la dernière
For i = Len(fcode) To Len(fcode) - 1 Step -1
If Mid(fcode, i, 1) Like "#" Then 'la position est un chiffre
chiffres = chiffres + Mid(fcode, i, 1)
Else
Exit For 'la position n'est pas un chiffre, on quitte la boucle
End If
Next i
'ici chiffres contient 0,1 ou 2 chiffres
If lettres <> "" And chiffres <> "" Then 'si chiffres et lettres non vides
If Len(lettres) = 1 Then ' si une seule lettre
formatcode = UCase(lettres) & Format(Val(chiffres), "00") 'code=lettre+2chiffres
Else 'si 2 lettres
formatcode = UCase(lettres) & " " & Format(Val(chiffres), "00") 'code=2lettres+" " +2chiffres
End If
Else 'sinon structure inconnue on renvoie le code fourni en paramètre sans modification
formatcode = fcode
End If
End FunctionSalut h2so4 ,
Super merci je l'ai exécuter et ça fonctionne mais j'aimerais comprendre le code pourrais tu m'expliquer comment tu procèdes ?
Merci d'avance
bonjour,
commentaires ajoutés dans le code ci-dessus.
Salut un grand merci à toi l'artiste je comprend mieux le code