Split sans valeur

Résolu
J0K0 Messages postés 167 Statut Membre -  
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,
J'ai un début de code assez générique afin de séparer une extraction réalisée par un logiciel de contrôle d'accès.
Néanmoins cette extraction réalise de temps à autres plusieurs valeurs du split.
Question ; est il possible de dire que si la valeur du split <> "" on poursuit sinon non ? Le code réalisé donne une erreur justement quand c'est vide ...
En gras, là où ça plante ...

Sub couper()
'copie/colle la feuille après la feuille extraction
Sheets(1).Copy after:=Sheets(1)
'renome la feuille en date du jour
aujour = Format(Now, "yyyy.mm.dd")
Sheets(2).Name = aujour

'coupe les virgules
With Sheets(1)
i = 1
'vale = Sheets(1).Range("A" & i).Value
'For vale = 1 To Sheets(1).Range("65000").End(xlUp).Row

Do While Sheets(1).Range("A" & i).Value <> ""
vale = Sheets(1).Range("A" & i).Value
sup = Split(vale, ",")

'colle sans les valeurs sans les virgules
nvale1 = sup(0) 'nom
nvale2 = sup(1) 'prénom
nvale3 = sup(2) 'photo
nvale4 = sup(3) 'actif/non actif
nvale5 = sup(4) 'N° profil
nvale6 = sup(5) 'N° profil
If sup(6) <> "" Then
nvale7 = sup(6) 'N° profil
ElseIf sup(7) <> "" Then
nvale8 = sup(7) 'scan badge
<bold>ElseIf sup(8) <> "" Then</bold>
nvale9 = sup(8) 'entreprise
Else
End If

If nvale1 <> "" Then
Sheets(2).Range("A" & i).Value = nvale1 'nom
ElseIf nvale2 <> "" Then
Sheets(2).Range("B" & i).Value = nvale2 'prénom
ElseIf nvale3 <> "" Then
Sheets(2).Range("C" & i).Value = nvale3 'photo
ElseIf nvale4 <> "" Then
Sheets(2).Range("D" & i).Value = nvale4 'actif/non actif
ElseIf nvale5 <> "" Then
Sheets(2).Range("E" & i).Value = nvale5 'N°
ElseIf nvale6 <> "" Then
Sheets(2).Range("F" & i).Value = nvale6 'N°
ElseIf nvale7 <> "" Then
Sheets(2).Range("G" & i).Value = nvale7 'N°
ElseIf nvale8 <> "" Then
Sheets(2).Range("H" & i).Value = nvale8 'scan badge
ElseIf nvale9 <> "" Then
Sheets(2).Range("I" & i).Value = nvale9 'entreprise
Else
End If

i = i + 1
Loop

'Loop
'Next vale
End With

MsgBox ("extraction terminée")
End Sub


Merci pour cette aide.


EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.

2 réponses

  1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonsoir, il suffit peut-être d'ajouter
    if ubound(sup)<8 then
        ReDim Preserve sup(8)
    end if
    après
    sup = Split(vale, ",")

    sinon, tu pourrais prendre
    ubound(sup)
    , cela te donnerait l'index maximum de sup.
    0
    1. J0K0 Messages postés 167 Statut Membre 17
       
      aie je ne comprends pas ces codes (je débute avec VBA) ... possible d'avoir une explication en mode rapide ?
      0
    2. J0K0 Messages postés 167 Statut Membre 17
       
      code placé après
      sup=split(vale,",")
      et erreur à :
        ReDim Preserve sup(8)


      merci
      0
    3. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > J0K0 Messages postés 167 Statut Membre
       
      message d'erreur?
      montre comment tu l'as inséré.
      0
    4. J0K0 Messages postés 167 Statut Membre 17
       
      Sub couper()
      'copie/colle la feuille après la feuille extraction
      Sheets(1).Copy after:=Sheets(1)
      'renome la feuille en date du jour
      aujour = Format(Now, "yyyy.mm.dd")
      Sheets(2).Name = aujour
      
      'coupe les virgules
      With Sheets(1)
      i = 1
      'vale = Sheets(1).Range("A" & i).Value
      'For vale = 1 To Sheets(1).Range("65000").End(xlUp).Row
      
      Do While Sheets(1).Range("A" & i).Value <> ""
      vale = Sheets(1).Range("A" & i).Value
      
      sup = Split(vale, ",")
      
      ''If UBound(sup) < 8 Then
      ''    ReDim Preserve sup(8)
      ''End If
      
      'colle sans les valeurs sans les virgules
      nvale1 = sup(0) 'nom
      nvale2 = sup(1) 'prénom
      nvale3 = sup(2) 'photo
      nvale4 = sup(3) 'actif/non actif
      nvale5 = sup(4) 'N° profil
      nvale6 = sup(5) 'N° profil
      If UBound(sup) < 6 Then  'sup(6) <> "" Then
      nvale7 = sup(6) 'N° profil
      ElseIf UBound(sup) < 7 Then 'sup(7) <> "" Then
      nvale8 = sup(7) 'scan badge
      'ElseIf sup(8) <> "" Then
      ElseIf UBound(sup) < 8 Then
      nvale9 = sup(8) 'entreprise
      Else
      End If
      
      If nvale1 <> "" Then
      Sheets(2).Range("A" & i).Value = nvale1 'nom
      ElseIf nvale2 <> "" Then
      Sheets(2).Range("B" & i).Value = nvale2 'prénom
      ElseIf nvale3 <> "" Then
      Sheets(2).Range("C" & i).Value = nvale3 'photo
      ElseIf nvale4 <> "" Then
      Sheets(2).Range("D" & i).Value = nvale4 'actif/non actif
      ElseIf nvale5 <> "" Then
      Sheets(2).Range("E" & i).Value = nvale5 'N°
      ElseIf nvale6 <> "" Then
      Sheets(2).Range("F" & i).Value = nvale6 'N°
      ElseIf nvale7 <> "" Then
      Sheets(2).Range("G" & i).Value = nvale7 'N°
      ElseIf nvale8 <> "" Then
      Sheets(2).Range("H" & i).Value = nvale8 'scan badge
      ElseIf nvale9 <> "" Then
      Sheets(2).Range("I" & i).Value = nvale9 'entreprise
      Else
      End If
      
      i = i + 1
      Loop
      
      'Loop
      'Next vale
      End With
      
      MsgBox ("extraction terminée")
      End Sub
      

      c'est commenté mais ça te donne une idée .....
      en fait sup(8) est vide .... ou n'existe pas ....
      d'où le code initial qui me paraissait juste if sup(0) <> "" then ... mais qui ne l'est pas !
      0
    5. J0K0 Messages postés 167 Statut Membre 17
       
      l'indice n'appartient pas à la sélection
      erreur à :
      nvale8 = sup(7) 'scan badge
      0
  2. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    il serait peut-être plus simple, après la ligne 15, d'ajouter
    vale = vale & ",,,,,,,,,,"
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re tous,
      a mon avis ca ne marche pas comme vous voudiriez
      If nvale1 <> "" Then
      Sheets(2).Range("A" & i).Value = nvale1 'nom
      ElseIf nvale2 <> "" Then
      Sheets(2).Range("B" & i).Value = nvale2 'prénom


      exemple de code:
      Sub couper()
          'copie/colle la feuille après la feuille extraction
          Sheets(1).Copy after:=Sheets(1)
          'renome la feuille en date du jour
          aujour = Format(Now, "yyyy.mm.dd")
          Sheets(2).Name = aujour
      
          'coupe les virgules
          With Sheets(1)
              derlig = .Range("A" & Rows.Count).End(xlUp).Row
              Plage = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
              i = 1
              For Each cel In Plage
                  sup = Split(cel, ",")
                  Nb = UBound(sup)
                  Col = 1
                  For n = 0 To Nb
                      If sup(n) <> "" Then
                          Sheets(2).Cells(i, Col).Value = sup(n)
                      End If
                      Col = Col + 1
                  Next n
                  i = i + 1
              Next cel
          End With
      
          MsgBox ("extraction terminée")
      End Sub
      0
      1. J0K068 Messages postés 32 Statut Membre > f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention  
         
        Bon c'est ok ça fonctionne parfaitement !!!
        merci beaucoup, comme d'hab vous m'sortez de la misère !!!
        0
      2. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > J0K068 Messages postés 32 Statut Membre
         
        peux-tu marquer comme résolu, via la roue dentée à droite du titre?
        0