VBA: Comment definir une variable qui correspond a une formule

[Delux]

Bonjour a tous,

(desole pour les accents je bosse sur qwerty).

Pourriez-vous me dire comment definir cette object variable : Dim Donnees As ??????

Donnees = Split(Sheet3.Range("H" & Cel.Row), "/")

Voici la macro complete pour information:

Sub DrawingNb_Progress()


Dim Cel As Range
Dim Lg As Integer

Lg = 4
Sheet3.Range("AQ4:AR65489").ClearContents
Donnees = Split(Sheet3.Range("H" & Cel.Row), "/")


For Each Cel In Sheet3.Range("H4:H" & [H65489].End(xlUp).Row)
    If Cel.Value <> "" And Not Cel.Find("/") Is Nothing Then
    

        If Len(Sheet3.Range("H" & Lg).Value) < 17 Then
        Sheet3.Range("AR" & Lg) = Left(Donnees(0), 5) & Right(Donnees(1), 3)
        Else
        Sheet3.Range("AQ" & Lg) = Donnees(0)
        Sheet3.Range("AR" & Lg) = Donnees(1)
        End If
        Lg = Lg + 1
    End If
   Next
        
End Sub

Si je definis Dim Donnees As String, j'obtiens une erreur "Expected Array"

Merci d'avance pour votre aide et vos lumiaires

Cordialement,

Delux

 

[Efgé]

Re : VBA: Comment definir une variable qui correspond a une formule

Bonjour Delux, Dans ce cas il faut utiliser

Dim Donnees  As Variant

Mais cela ne réglera pas le problème car tu utilise

Donnees = Split(Sheet3.Range("H" & Cel.Row), "/")

avant d'avoir défini ce qu'est Cel

For Each Cel In Sheet3.Range("H4:H" & [H65489].End(xlUp).Row)

A mon avis, il sera préférable de déplacer la ligne Donnees = ..... après la condition:

If Cel.Value  "" And Not Cel.Find("/") Is Nothing Then

Cordialement

 

[Delux]

Re : VBA: Comment definir une variable qui correspond a une formule

Bonjour Efge,

La macro tourne desormais sans erreur.

Maintenant mon probleme est autre, j'ai insere cette macro dans une autre macro (progressBar) pour voir l'avancee de la macro qui dans le fichier original prend enormement de temps.

Hors, ma macro tourne en continue et la progressBar n'avance pas :/

Auriez-vous une solution?

Voici la macro :

Option Explicit

Sub StartProcessing1()
' displays a progress bar while a macro runs, requires a reference to MSCOMCTRL.OCX
Dim lngTotal As Long, lngI As Long
Dim Cel As Range
Dim Lg As Integer
Dim Donnees As Variant


    ' initiate progressbar
    Load frmProgressBar1
    With frmProgressBar1
        .ProgressBar1.Scrolling = ccScrollingSmooth ' or ccScrollingSmooth
        .Show ' set the UserForms ShowModal property to false before running
        ' or .Show False
    End With
    UpdateProgressBar1 0, "Processing..." ' set initial progress status
    ' start the process
    lngTotal = 200
    For lngI = 1 To lngTotal
        If lngI Mod 10 = 0 Then ' update the progressbar for every 50th loop
            UpdateProgressBar1 lngI / lngTotal * 100, "Processing " & Format(lngI / lngTotal, "0%") & "..."
        End If
        ' do something, place your code here
        'Range("C2").Formula = Format(Time, "hh:mm:ss")
    'Application.Run "drawing_split"
   
     Sheet3.Range("AQ4:AR65489").ClearContents
    Lg = 4
    For Each Cel In Sheet3.Range("H4:H" & [H65489].End(xlUp).Row)
    If Cel.Value <> "" And Not Cel.Find("/") Is Nothing Then
        Donnees = Split(Sheet3.Range("H" & Cel.Row), "/")

        If Len(Sheet3.Range("H" & Lg).Value) < 17 Then
        Sheet3.Range("AR" & Lg).Value = Left(Donnees(0), 5) & Right(Donnees(1), 3)
        Else
        Sheet3.Range("AQ" & Lg).Value = Donnees(0)
        Sheet3.Range("AR" & Lg).Value = Donnees(1)
        End If
        Lg = Lg + 1
    End If
   
    Next
    Next lngI
    
    'Range("C2").ClearContents
    ' clean up
    frmProgressBar1.Hide
    Unload frmProgressBar1
End Sub

Private Sub UpdateProgressBar1(NewValue As Single, Optional NewCaption As String)
' updates the progressbar dialog
    With frmProgressBar1
        If Not IsMissing(NewCaption) Then .Caption = NewCaption
        .ProgressBar1.Value = NewValue
        If NewValue = 0 Then .Repaint
    End With
End Sub

Cordialement,

Delux

 

[Dranreb]

Re : VBA: Comment definir une variable qui correspond a une formule

Bonjour.
Écrivez tout ça comme ça, vous n'aurez plus besoin de progress bar !

Sub DrawingNb_Progress()

Dim Lg As Long
Dim Z As String, Donnees() As String
Dim Te() As Variant, Ts() As Variant

Te = Sheet3.Range("H4:H" & [H65489].End(xlUp).Row).Value
ReDim Ts(1 To UBound(Te), 1 To 2)
For Lg = 1 To UBound(Te): Z = Te(Lg, 1)
   If Z <> "" And InStr(Z, "/") > 0 Then
      Donnees = Split(Z, "/")
      If Len(Z) < 17 Then
         Ts(Lg, 2) = Left$(Donnees(0), 5) & Right$(Donnees(1), 3)
      Else
         Ts(Lg, 1) = Donnees(0)
         Ts(Lg, 2) = Donnees(1)
         End If
      End If
   Next Lg
Sheet3.[AQ4:AR65489].ClearContents
Sheet3.[AQ4:AR4].Resize(UBound(Ts)).Value = Ts
End Sub

Cordialement.

 

[Delux]

Re : VBA: Comment definir une variable qui correspond a une formule

Bonsoir Dranreb,

Merci pour votre Macro elle est effectivement plus rapide :O
Pourriez-vous rajouter quelques explications pour une meilleur comprehension?

Pour la progressBar j'ai trouve mais le probleme est qu'elle evolue a chaque fois que le code se relance de nouveau.
En gros, elle progresse a chaque fois que le code se relance une nouvelle fois, et vu que ma macro prennait beaucoup de temps a s'executer, je vous laisse imaginer...

En tout cas merci

Cordialement,

Delux

 

[Dranreb]

Re : VBA: Comment definir une variable qui correspond a une formule

Sub DrawingNb_Progress()

Dim Lg As Long
Dim Z As String
Dim Donnees() As String ' Tableau dynamique de String
Dim Te() As Variant, Ts() As Variant ' Tableaux dynamiques de Variant

Te = Sheet3.Range("H4:H" & [H65489].End(xlUp).Row).Value ' Récupère tout d'un coup.
ReDim Ts(1 To UBound(Te), 1 To 2) ' Tableau de sortie au nombre de lignes de celui d'entrée et 2 colonnes.
For Lg = 1 To UBound(Te) ' Pour Lg = 1 au nombre de lignes:
   Z = Te(Lg, 1) ' Ça vaut le coup d'écrire Z partout au lieu de Te(Lg, 1). 1 c'est pour l'unique colonne.
   If InStr(Z, "/") > 0 Then ' S'il contient un slash:
      Donnees = Split(Z, "/")
      If Len(Z) < 17 Then
         Ts(Lg, 2) = Left$(Donnees(0), 5) & Right$(Donnees(1), 3)
      Else
         Ts(Lg, 1) = Donnees(0)
         Ts(Lg, 2) = Donnees(1)
         End If
      End If
   Next Lg
Sheet3.[AQ4:AR65489].ClearContents
Sheet3.[AQ4:AR4].Resize(UBound(Ts)).Value = Ts ' Décharge tout d'un coup
End Sub

À +