VBA : Erreur424 au sein d'une boucle
Résolu/Ferméf894009 Messages postés 17239 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 10 février 2025 - 15 sept. 2023 à 07:29
- VBA : Erreur424 au sein d'une boucle
- Excel compter cellule couleur sans vba - Guide
- Mkdir vba ✓ - Forum VB / VBA
- Vba range avec variable ✓ - Forum VB / VBA
- L'indice n'appartient pas à la sélection vba ✓ - Forum Programmation
- Autofill vba ✓ - Forum Excel
6 réponses
11 sept. 2023 à 16:17
Bonjour,
votre fichier et un csv seraient tres utiles pour vous aider
Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com
Allez sur ce site : http://cjoint.com
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...
11 sept. 2023 à 17:06
Bonjour je vais vous fournir le fichier de test, en revanche je ne peux pas vous fournir de csv avec des données, pour la confidentialité de mes clients.
Le fichier de vérification:
https://www.cjoint.com/c/MIlpepDPSlA
Le CSV avec les entêtes seulements
https://www.cjoint.com/c/MIlpe78j57A
11 sept. 2023 à 17:56
Re,
Une histoire de voyelle accentuee dans le nom d'onglet et pas dans
Dim ErreursTrouvees As Worksheet
Donc ne pas en mettre partout
Voir dans ce test
If LevenshteinDistance(NomColonne, NomColonneAutorise) <= 2 Then
12 sept. 2023 à 11:15
ça fonctionne!! merci beaucoup!!
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question13 sept. 2023 à 16:38
Je reviens avec mon erreur 424, mais à priori dans un nouvel endroit du code.
J'ai voulu intégrer une vérification de présence de colonnes obligatoire dans mon code, avec une partie coditionnée par la présence d'autres colonnes.
Code ci-dessous:
Sub ImporterFichierCSV()
Dim MonClasseur As Workbook
Dim FeuilleImport As Worksheet
Dim FeuilleErreurs As Worksheet
Dim CheminFichier As Variant
Dim TexteFichier As String
Dim LignesFichier() As String
Dim i As Long
Dim FeuilleDonneesImport As Worksheet
Dim FeuilleColonnes As Worksheet
Dim Cellule As Range
Dim nomColonne As String
Dim CorrespondanceTrouvee As Boolean
Dim ErreursTrouvees As Worksheet
Dim DerniereLigneErreur As Long
Dim CelluleEntete As Range
' Creer un nouveau classeur Excel
Set MonClasseur = ThisWorkbook ' Utilisez ThisWorkbook si vous executez le code dans le classeur actif
' Reference à la feuille "Erreurs trouvees" ou la creer si elle n'existe pas
On Error Resume Next
Set ErreursTrouvees = MonClasseur.Sheets("Erreurs trouvees")
On Error GoTo 0
If ErreursTrouvees Is Nothing Then
Set ErreursTrouvees = MonClasseur.Sheets.Add
ErreursTrouvees.Name = "Erreurs trouvees"
End If
' Effacer le contenu de la feuille "Erreurs trouvees" (à l'exception des en-têtes)
If ErreursTrouvees.Cells(2, 1).Value <> "" Then
ErreursTrouvees.Rows("2:" & ErreursTrouvees.Rows.Count).Clear
End If
' Ajouter les en-têtes uniquement si elles n'ont pas dejà ete ajoutees
If ErreursTrouvees.Cells(1, 1).Value = "" Then
ErreursTrouvees.Cells(1, 1).Value = "Type erreur"
ErreursTrouvees.Cells(1, 2).Value = "Cellule concernee"
ErreursTrouvees.Cells(1, 3).Value = "Correction"
End If
' Dernière ligne de la feuille "Erreurs trouvees"
DerniereLigneErreur = 2
' Verifier si la feuille "Donnees d'import" existe, sinon la creer
On Error Resume Next
Set FeuilleImport = MonClasseur.Sheets("Donnees d'import")
On Error GoTo 0
If FeuilleImport Is Nothing Then
Set FeuilleImport = MonClasseur.Sheets.Add
FeuilleImport.Name = "Donnees d'import"
End If
' Boîte de dialogue de recherche de fichier
CheminFichier = Application.GetOpenFilename("Fichiers CSV (*.csv), *.csv")
' Verifier si un fichier a ete selectionne
If CheminFichier = "Faux" Then
MsgBox "Aucun fichier selectionne. L'importation est annulee.", vbExclamation
Exit Sub
End If
' Lire le contenu du fichier CSV et copier dans la feuille "Donnees d'import"
Dim ligne As String
Dim numLigne As Long
numLigne = 1
' Verifier et traiter le fichier CSV
Dim sep As String
sep = ";"
numLigne = 1
Open CheminFichier For Input As #1
Do Until EOF(1)
Line Input #1, ligne
' Verifier si le separateur est un point-virgule
If InStr(ligne, sep) > 0 Then
' Si le separateur est trouve, diviser la ligne et copier dans des colonnes separees
Dim colonnes() As String
colonnes = Split(ligne, sep)
For i = LBound(colonnes) To UBound(colonnes)
FeuilleImport.Cells(numLigne, i + 1).Value = colonnes(i)
Next i
Else
' Si le separateur n'est pas trouve, afficher un message d'erreur et arrêter le traitement
MsgBox "Le fichier ne comporte pas de separateurs point-virgules. L'importation est annulee.", vbExclamation
Close #1
Exit Sub
End If
numLigne = numLigne + 1
Loop
Close #1
' Afficher un message lorsque l'importation est reussie
MsgBox "Le fichier CSV a ete importe avec succès dans la feuille Donnees d'import.", vbInformation
' Initialisation du fichier OK
' Reference au classeur Excel actif
Set MonClasseur = ThisWorkbook ' Utilisez ThisWorkbook si vous executez le code dans le classeur actif
' Reference à la feuille "Donnees d'import"
Set FeuilleImport = MonClasseur.Sheets("Donnees d'import")
' Reference à la feuille "Colonnes"
Set FeuilleColonnes = MonClasseur.Sheets("Colonnes")
' Reference à la feuille "Erreurs trouvees" ou la creer si elle n'existe pas
On Error Resume Next
Set ErreursTrouvees = MonClasseur.Sheets("Erreurs trouvees")
On Error GoTo 0
If ErreursTrouvees Is Nothing Then
Set ErreursTrouvees = MonClasseur.Sheets.Add
ErreursTrouvees.Name = "Erreurs trouvees"
End If
' Dernière ligne de la feuille "Erreurs trouvees"
DerniereLigneErreur = ErreursTrouvees.Cells(Rows.Count, 1).End(xlUp).Row + 1
' Parcourir les cellules en ligne 1 de la feuille "Donnees d'import"
For Each CelluleEntete In FeuilleImport.Rows(1).Cells
Debug.Print "NomColonne: " & CelluleEntete.Value ' Ajoutez cette ligne pour deboguer
nomColonne = CelluleEntete.Value
CorrespondanceTrouvee = False
' Vérifier la correspondance avec les noms autorisés
Dim NomColonneAutorise As String
For Each CelluleAutorisee In FeuilleColonnes.Range("A2:A" & FeuilleColonnes.Cells(FeuilleColonnes.Rows.Count, 1).End(xlUp).Row)
NomColonneAutorise = CelluleAutorisee.Value
' Ignorer les colonnes vides
If NomColonneAutorise <> "" Then
' Verifier si le nom de colonne correspond parfaitement
If nomColonne = NomColonneAutorise Then
CorrespondanceTrouvee = True
Exit For
End If
' Verifier si la difference d'ecriture est de 1 à 2 caractères
If LevenshteinDistance(nomColonne, NomColonneAutorise) <= 2 Then
CorrespondanceTrouvee = True
' Enregistrer l'erreur dans la feuille "Erreurs trouvees"
MonClasseur.Sheets("Erreurs trouvees").Cells(DerniereLigneErreur, 1).Value = "Defaut d'ecriture"
ErreursTrouvees.Cells(DerniereLigneErreur, 2).Value = CelluleEntete.Address
ErreursTrouvees.Cells(DerniereLigneErreur, 3).Value = NomColonneAutorise
DerniereLigneErreur = DerniereLigneErreur + 1
Exit For
End If
End If
Next CelluleAutorisee
' Si aucune correspondance n'est trouvée et que la colonne n'est pas vide, enregistrer l'erreur dans la feuille "Erreurs trouvees"
If Not CorrespondanceTrouvee And nomColonne <> "" Then
ErreursTrouvees.Cells(DerniereLigneErreur, 1).Value = "Nom de colonne non autorise : " & nomColonne
ErreursTrouvees.Cells(DerniereLigneErreur, 2).Value = CelluleEntete.Address
DerniereLigneErreur = DerniereLigneErreur + 1
End If
Next CelluleEntete
'Fin de vérification des bons noms de cellules
'Début de vérification de présence des cellules obligatoires
' Référence à la feuille "ColonnesObligatoires"
Dim FeuilleColonnesObligatoires As Worksheet
On Error Resume Next
Set FeuilleColonnesObligatoires = MonClasseur.Sheets("ColonnesObligatoires")
On Error GoTo 0
' Vérifier si la feuille "ColonnesObligatoires" existe
If FeuilleColonnesObligatoires Is Nothing Then
MsgBox "La feuille 'ColonnesObligatoires' n'existe pas. L'importation est annulée.", vbExclamation
Exit Sub
End If
' Liste des colonnes obligatoires dans la plage A2 à A40 de la feuille "ColonnesObligatoires"
Dim ListeColonnesObligatoires As Collection
Set ListeColonnesObligatoires = New Collection
Dim CelluleColonneObligatoire As Range
For Each CelluleColonneObligatoire In FeuilleColonnesObligatoires.Range("A2:A40")
' Récupérer le contenu de la cellule en colonne A
NomColonneA = CelluleColonneObligatoire.Value
' Récupérer le contenu de la cellule en colonne B
NomColonneB = CelluleColonneObligatoire.Offset(0, 1).Value
' Vérifier si NomColonneB existe dans ColonnesImportees (feuille d'import)
If ColonnesImportees.Exists(NomColonneB) Then
' La colonne en A devient obligatoire
' Votre code pour ajouter la colonne en A à la liste des colonnes obligatoires
Else
' La colonne en A reste obligatoire
If NomColonneA <> "" Then
' Votre code pour ajouter la colonne en A à la liste des colonnes obligatoires
End If
End If
Next CelluleColonneObligatoire
' Vérifier les noms de colonnes obligatoires
Dim ColonneImport As Range
Dim ColonneNom As String
' Réinitialiser la dernière ligne d'erreur en fonction de la dernière erreur trouvée précédemment
DerniereLigneErreur = MonClasseur.Sheets("Erreurs trouvees").Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim ColonnesManquantes As Boolean
ColonnesManquantes = False
' Créer un dictionnaire pour stocker les colonnes importées
Set ColonnesImportees = CreateObject("Scripting.Dictionary")
' Remplir le dictionnaire avec les colonnes importées
For Each ColonneImport In FeuilleImport.Rows(1).Cells
ColonneNom = ColonneImport.Value
If Not IsEmpty(ColonneNom) Then
ColonnesImportees(ColonneNom) = True
End If
Next ColonneImport
For Each NomColonneObligatoire In ListeColonnesObligatoires
If Not ColonnesImportees.Exists(NomColonneObligatoire) Then
' Si la colonne obligatoire est manquante dans les colonnes importées
MonClasseur.Sheets("Erreurs trouvees").Cells(DerniereLigneErreur, 1).Value = "Colonne obligatoire manquante"
MonClasseur.Sheets("Erreurs trouvees").Cells(DerniereLigneErreur, 2).Value = NomColonneObligatoire
DerniereLigneErreur = DerniereLigneErreur + 1
ColonnesManquantes = True
End If
Next NomColonneObligatoire
If ColonnesManquantes Then
' Si des colonnes obligatoires sont manquantes, afficher un message et quitter la procédure
MsgBox "Des colonnes obligatoires sont manquantes dans le fichier importé. Consultez la feuille 'Erreurs trouvees' pour plus de détails.", vbExclamation
Exit Sub
Else
' Si toutes les colonnes obligatoires sont présentes, vérifier que les cellules de ces colonnes sont renseignées
Dim LigneDonnees As Long
Dim Colonne As Range
For Each NomColonneObligatoire In ListeColonnesObligatoires
' Récupérer la colonne correspondant au nom de colonne obligatoire
Set Colonne = FeuilleImport.Rows(1).Find(NomColonneObligatoire)
If Not Colonne Is Nothing Then
' Si la colonne est trouvée dans la feuille d'import
For LigneDonnees = 2 To FeuilleImport.Cells(Rows.Count, Colonne.Column).End(xlUp).Row
' Vérifier si la cellule de la colonne est vide
If IsEmpty(FeuilleImport.Cells(LigneDonnees, Colonne.Column)) Then
' Si la cellule est vide, enregistrer l'erreur
MonClasseur.Sheets("Erreurs trouvees").Cells(DerniereLigneErreur, 1).Value = "Cellule non renseignée"
MonClasseur.Sheets("Erreurs trouvees").Cells(DerniereLigneErreur, 2).Value = FeuilleImport.Cells(LigneDonnees, Colonne.Column).Address
DerniereLigneErreur = DerniereLigneErreur + 1
End If
Next LigneDonnees
End If
Next NomColonneObligatoire
If DerniereLigneErreur = 2 Then
' Si aucune erreur n'a été trouvée, afficher un message de succès
MsgBox "Toutes les colonnes obligatoires sont présentes et renseignées dans le fichier importé.", vbInformation
Else
' Si des cellules non renseignées ont été trouvées, afficher un message d'erreur
MsgBox "Des cellules non renseignées ont été trouvées dans le fichier importé. Consultez la feuille 'Erreurs trouvees' pour plus de détails.", vbExclamation
End If
End If
' Si des erreurs ont ete trouvees, afficher un message
If DerniereLigneErreur > 2 Then
MsgBox "Des erreurs ont ete trouvees. Consultez la feuille 'Erreurs trouvees' pour plus de details.", vbExclamation
Else
MsgBox "Aucune erreur de nom de colonne n'a ete trouvee.", vbInformation
End If
End Sub
Function LevenshteinDistance(ByVal s As String, ByVal t As String) As Integer
' Calcule la distance de Levenshtein (distance d'edition) entre deux chaînes de caractères
Dim d() As Integer
Dim sLen As Integer
Dim tLen As Integer
Dim cost As Integer
Dim n As Integer
Dim m As Integer
Dim i As Integer
Dim j As Integer
Dim distance As Integer
sLen = Len(s)
tLen = Len(t)
ReDim d(0 To sLen, 0 To tLen)
For i = 0 To sLen
d(i, 0) = i
Next i
For j = 0 To tLen
d(0, j) = j
Next j
For i = 1 To sLen
For j = 1 To tLen
If Mid(s, i, 1) = Mid(t, j, 1) Then
cost = 0
Else
cost = 1
End If
d(i, j) = WorksheetFunction.Min(d(i - 1, j) + 1, d(i, j - 1) + 1, d(i - 1, j - 1) + cost)
Next j
Next i
LevenshteinDistance = d(sLen, tLen)
End Function
Function CollectionContains(col As Collection, item As Variant) As Boolean
On Error Resume Next
CollectionContains = (col.item(item) Is Nothing)
On Error GoTo 0
End Function
Function ColumnExistsInImportSheet(ByVal nomColonne As String, ByVal feuille As Worksheet) As Boolean
' Vérifie si la colonne existe dans la feuille d'import
On Error Resume Next
ColumnExistsInImportSheet = Not feuille.Cells(1, nomColonne).EntireColumn Is Nothing
On Error GoTo 0
End Function
Modifié le 14 sept. 2023 à 07:35
Bonjour,
Je regarde la chose
Suite:
J'ai une erreur 9 sur cette ligne, avez vous ajoute une feuille par rapport a votre fichier mis a dispo post <2>?
' Reference à la feuille "Colonnes" Set FeuilleColonnes = MonClasseur.Sheets("Colonnes")
15 sept. 2023 à 07:29
Bonjour,
Vous avez aussi une variable tableau qui s'appelle colonnes!!