XL 2010 Erreur 1004, definie par l'application ou l'objet, dans une boucle

N

Nicko29

XLDnaute Nouveau
Bonjour,

Je peine à me corriger, j'ai une erreur 1004 qui se produit dans une boucle du code, alors que le code marche et boucle correctement sur une dizaine de ligne puis plante. sur cette ligne.
J'ai l'impression que j'ai loupé un truc, je ne suis pas non plus un pro VBA.
Une idée ? je tourne en rond.

Code: 
WsDM.Cells(j, ColReg) = WsREAL.Cells(L, c).Value

code entier :

Code: 
Option Explicit

Public Const F_DM = "Table_Echange"
Public Const F_UINT = "Export_UINT"
Public Const F_UINTBCD = "Export_UINT_BCD"
Public Const F_REAL = "Export_REAL"
Public Const F_MAJ = "SUIVI_MODIF"
Public Const F_LEG = "LEGENDE"

Public Const Ndepart = 2
Public Const Categorie1 = "Télé-Réglage"
Public Const Categorie2 = "Recette"
Public Const T_UINT = "UINT"
Public Const T_UINT_BCD = "UINT HEXA"
Public Const T_REAL = "REAL"
Public Const NomColCategorie = "CATEGORIE"
Public Const NomColType = "TYPE"
Public Const NomColDM = "ADRESSE FINS"
Public Const NomColREG = "Réglages"

Public ColCat As Integer
Public ColType As Integer
Public ColDM As Integer
Public ColReg As Integer

Function RecupCol()

Dim WsDM As Worksheet
Set WsDM = ThisWorkbook.Worksheets(F_DM)
On Error GoTo ErrorHandler
ColCat = WsDM.Cells.Find(What:=NomColCategorie, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Column
ColType = WsDM.Cells.Find(What:=NomColType, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Column
ColDM = WsDM.Cells.Find(What:=NomColDM, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Column
ColReg = WsDM.Cells.Find(What:=NomColREG, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Column
GoTo FIN
ErrorHandler:
MsgBox " Vérifier l'orthographe des noms d'entête des colonnes " & NomColCategorie & " , " & NomColType & " , " & NomColDM & " , " & NomColREG & "  , puis relancer l'opération "
FIN:
End Function

Sub Importation_DM()

Dim d As Long

Dim A, B As String
Dim i, j, L, c, cpt As Integer
Dim ldm As Variant
Dim DM As Variant
Dim WsDM As Worksheet
Dim WsUnit As Excel.Worksheet
Dim WsUBCD As Excel.Worksheet
Dim WsREAL As Excel.Worksheet


'====== attribue une référence d'objet à la variable.
Set WsDM = Application.ThisWorkbook.Worksheets(F_DM)
Set WsUnit = Application.ThisWorkbook.Worksheets(F_UINT)
Set WsUBCD = Application.ThisWorkbook.Worksheets(F_UINTBCD)
Set WsREAL = Application.ThisWorkbook.Worksheets(F_REAL)

'===== appel macro Récupération de numéro de olonne
RecupCol

'===== boucle pour tester l'existence et le nom des feuilles
For i = 1 To ThisWorkbook.Worksheets.Count

Select Case ThisWorkbook.Worksheets(i).Name

        Case F_DM, F_UINT, F_UINTBCD, F_REAL, F_MAJ, F_LEG
        ' elle est présente
        Case Else
        MsgBox "La Feuille " & ThisWorkbook.Worksheets(i).Name & "  est inexistante ou mal orthographiée "
GoTo arret
End Select
Next i

'====== Conversion en nombre de la feuille real
For j = 2 To 6
WsREAL.Columns(j).TextToColumns FieldInfo:=Array(1, 1)
WsREAL.Columns(j).NumberFormat = "000.0"
Next j

'====== boucle qur la feuille "Table_echange" pour trovuer les DM en fonction de la catégorie et type ( format)
'd = WsDM.Range("G" & Rows.Count).End(xlUp).Row ' récupération de la dernière ligne remplie
d = WsDM.Cells(Columns(ColDM).Cells.Count, 1).End(xlUp).Row
For j = Ndepart To d


A = WsDM.Cells(j, ColCat).Value
B = WsDM.Cells(j, ColType).Value   ' B = WsDM.Range("F" & j).Value
DM = WsDM.Cells(j, ColDM).Value   'DM = WsDM.Range("G" & j).Value

'Test si case DM vide ou s'il  comporte un nombre différent de caractères
If Len(DM) = 0 Then
MsgBox "Absence de DM dans la cellule , colonne " & ColDM & " Ligne " & j
GoTo LigneSuiv
ElseIf (A = Categorie1 Or A = Categorie2) And Len(DM) < 4 Then
MsgBox "Nom de DM incorrect dans la cellule : colonne " & ColDM & " Ligne " & j
MsgBox Len(DM)
WsDM.Cells(j & ColDM).Interior.Color = 65535  ' coloriage de la cellule incorrect pour repère
GoTo LigneSuiv
Else
End If

If (A = Categorie1 Or A = Categorie2) And B = T_UINT Then   ' filter les DM par catégorie1  (Télé-Réglage) et catégorie2 (recette) et type ( UINT)
        ' Recupération UINT
        ldm = Mid(DM, 2, Len(DM) - 2) * 10 ' récupération de la valeur de DM sans l'unité ( et la premiere lettre D, pour la recherche de la ligne
        c = Right(DM, 1) + 2
        L = WsUnit.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Row ' recherche de la ligne du DM
       
        WsDM.Cells(j, ColReg) = WsUnit.Cells(L, c).Value
        cpt = cpt + 1
       
    ElseIf (A = Categorie1 Or A = Categorie2) And B = T_UINT_BCD Then ' filter les DM par catégorie1  (Télé-Réglage) et catégorie2 (recette)et type ( UINT_BCD)
        ' Recupération UINT_BCD
        ldm = Mid(DM, 2, Len(DM) - 2) * 10 'récupération de la valeur de DM sans l'unité ( et la premiere lettre D, pour la recherche de la ligne
        c = Right(DM, 1) + 2
        L = WsUBCD.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Row ' recherche de la ligne du DM
       
        WsDM.Cells(j, ColReg) = WsUBCD.Cells(L, c).Value
        cpt = cpt + 1
       
    ElseIf (A = Categorie1 Or A = Categorie2) And B = T_REAL Then ' filter les DM par catégorie1  (Télé-Réglage)et catégorie2 (recette)  et type ( REAL
           ' Recupération REAL
        ldm = Mid(DM, 2, Len(DM) - 2) * 10 'récupération de la valeur de DM sans l'unité ( et la premiere lettre D, pour la recherche de la ligne
        c = Right(DM, 1) ' on récupéré l'unité du DM
        'test l'unité du DM est impair
        If c Mod 2 <> 0 Then 'si c impair
        MsgBox " DM incorrect : valeur impair  dans la cellule G" & j
        WsDM.Cells(j & ColDM).Interior.Color = 65535  ' coloriage de la cellule incorrect pour repère
        GoTo LigneSuiv
        Else 'si c pair
        'on fait rien on continue
        End If
        Select Case c ' calcul de la colonne diférent en fonction de l'unité du DM
            Case 0
            c = c + 2
            Case 2
            c = c + 1
            Case 4
            c = c
            Case 6
            c = c - 1
            Case 8
            c = c - 2
            Case Else
        End Select
       
        L = WsREAL.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Row ' recherche de la ligne du DM
       
        WsDM.Cells(j, ColReg) = WsREAL.Cells(L, c).Value
       
       
        cpt = cpt + 1
    Else
End If
LigneSuiv:
Next j
MsgBox cpt & " paramètres ont été importé"
arret:
Set WsDM = Nothing
Set WsUnit = Nothing
Set WsUBCD = Nothing
Set WsREAL = Nothing
End Sub
 
Trier par date Trier par votes
N

Nicko29

XLDnaute Nouveau
Oui , ci-joint le tableau sans macro.

C'est exact je n'ai pas prévu l'éventualité ou L peut être Nothing. C peut effectivement être -1 aussi,

lorsque cela bloque, J = 256 ,ColReg = 16, L = 343 et c = "4"

la est surement le problème C = "4" au lieu de 4
J'ai repassé les lignes
Code: 
c = Right(DM, 1)...
en
Code: 
c = CInt(Right(DM, 1))
et j'ai corrigé l'erreur.
Reste que mon code n'est pas optimisé , je vais corriger çà pour C et L
 

Pièces jointes

  • table .xlsx
    901 KB · Affichages: 55
Dernière édition:
Vote positif 0 Vote négatif
N

Nicko29

XLDnaute Nouveau
Je bloque sur L, comment sortir de la marco si L is nothing ?

Code: 
L = WsREAL.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Row

ca nr marche pas comme ca :
Code: 
set L = WsREAL.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Row
puis Traiter la valeur de L cela ne marche avec le
Code: 
.row
à la fin
 
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
re,

en supprimant .Row
Code: 
set L = WsREAL.Cells.Find(What:=ldm, After:=[A1], LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False)

puis
Code: 
If Not L is Nothing Then
     'on récupère la ligne par L.Row
Else
     msgbox " Non trouvé"
     Exit Sub
End If


A+
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
384
Francky79
F
F
  • Résolu(e)
Microsoft 365 Commentaire cellule dans TextBox dans UserForm
Réponses
4
Affichages
582
Francky79
F
T
  • Question
XL 2019 Erreur définie par l'application ou par l'objet "1004"
Réponses
4
Affichages
1 K
terrier
T
D
  • Résolu(e)
Microsoft 365 code s'execute 2 fois
Réponses
4
Affichages
1 K
ODVJ
O
N
  • Question
insertion d'un nombre variable de données dans une boucle
2
Réponses
17
Affichages
2 K
ninajams
N
N
  • Question
XL 2010 Conversion nombre à virgule flottante IEEE 754 en décimal
Réponses
1
Affichages
7 K
Modeste geedee
Modeste geedee
P
  • Question
Rechercher une cellule dans classeur a parti d'un textbox
Réponses
6
Affichages
3 K
plouff
P
J
  • Question
Que rajouter dans cette macro pour faire une boucle?
Réponses
4
Affichages
667
julien75017
J
C
  • Question
XL 2013 filtrage et copiage de données dans une autre feuille excel
Réponses
13
Affichages
1 K
cedric_hiss
C
Usine à gaz
  • Question
RESOLU - macro qui ne recherche que dans une feuille du classeur
Réponses
0
Affichages
687
Usine à gaz
Usine à gaz

Membres actuellement en ligne

15 membres et 189 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 103
Messages
2 116 244
Membres
112 695
dernier inscrit
ben44115