Valeur "0" dans une macro

Le 10/08/2016 à 18:44

Bonjour,

Je travail actuellement sur une macro qui me permet de remplir une feuille avec des donnée provenant d'une autre feuille. J'ai deux problèmes majeurs.

Sub valider()
'
' valider Macro
'

'
    Set wst = Worksheets("Bilan_WP_FL")
    Set wss = Worksheets("Fiche_FL")
    ' dernière ligne+1 de récap sera par défaut la ligne où l'on va sauver les données
    dlt = wst.Range("A" & wst.Rows.Count).End(xlUp).Row + 1
    ' on recherche le point dans Bilan_WP_FL
    Set re = wst.Range("A1:A" & dlt).Find(wss.Range("C1"), lookat:=xlWhole)
    ' si on la trouve
    If Not re Is Nothing Then
     ans = MsgBox("il existe déjà des données pour ce point, on les remplace ?", vbYesNo)
     If ans = vbYes Then
      ' on veut remplacer on mémorise la ligne à modifier
      dlt = re.Row
     Else
     'on ne veut pas remplacer, c'est fini
      Exit Sub
     End If
    End If
    ' à adapter
    ' copie des données de enregistrement vers recap, dans la ligne dlt
    wst.Range("A" & dlt) = Format(wss.Range("C1"), "0")
    wst.Range("B" & dlt) = Format(wss.Range("D23"), "0")
    wst.Range("C" & dlt) = Format(wss.Range("D24"), "0")
    wst.Range("D" & dlt) = Format(wss.Range("D25"), "0")
    wst.Range("E" & dlt) = Format(wss.Range("D26"), "0")
    wst.Range("F" & dlt) = Format(wss.Range("D27"), "0")
    wst.Range("G" & dlt) = Format(wss.Range("D28"), "0")
    wst.Range("H" & dlt) = Format(wss.Range("D29"), "0")
    wst.Range("I" & dlt) = Format(wss.Range("D30"), "0")
    wst.Range("J" & dlt) = Format(wss.Range("D31"), "0")
    wst.Range("K" & dlt) = Format(wss.Range("D32"), "0")
    wst.Range("L" & dlt) = Format(wss.Range("D33"), "0")
      ' fin à adapter
    Set wst = Nothing
    Set re = Nothing
    Set wss = Nothing
    End Sub

Le premier, je souhaiterais que lorsqu'il n'y a pas de valeur il ne met pas "0", qu'il laisse la cellule vide

Deuxième problème, c'est la lenteur de l’exécution de cette macro qui prend facilement deux minute, est-ce normal ?

Merci pour votre aide précieuse

Le 10/08/2016 à 18:50

Bonjour

Il serait plus facile de faire des tests si tu joignais ton fichier....

Bye !

Bonjour

Il serait plus facile de faire des tests si tu joignais ton fichier.

Bye !

Le 10/08/2016 à 20:52

Bonsoir,

A tester en attendant un complément d'informations.

Cdlt.

Option Explicit

Sub valider()
Dim wb As Workbook
Dim wst As Worksheet, wss As Worksheet
Dim re As Range
Dim dlt As Long
Dim ans As VbMsgBoxResult

    Set wb = ThisWorkbook
    Set wst = wb.Worksheets("Bilan_WP_FL")
    Set wss = wb.Worksheets("Fiche_FL")

    ' dernière ligne+1 de récap sera par défaut la ligne où l'on va sauver les données
    dlt = wst.Range("A" & wst.Rows.Count).End(xlUp).Row + 1
    ' on recherche le point dans Bilan_WP_FL
    Set re = wst.Range("A1:A" & dlt).Find(wss.Range("C1"), lookat:=xlWhole)
    ' si on la trouve
    If Not re Is Nothing Then
        ans = MsgBox("il existe déjà des données pour ce point, on les remplace ?", vbYesNo)
        If ans = vbYes Then
            ' on veut remplacer on mémorise la ligne à modifier
            dlt = re.Row
        Else
            'on ne veut pas remplacer, c'est fini
            GoTo exit_Handler
        End If
    End If
    ' à adapter
    ' copie des données de enregistrement vers recap, dans la ligne dlt
    wst.Range("A" & dlt) = wss.Range("C1")
    wst.Range("B" & dlt & ":L" & dlt) = Application.Transpose(wss.Range("D23:D33"))

exit_Handler:
    Set wst = Nothing
    Set re = Nothing
    Set wss = Nothing
    Set wb = Nothing

End Sub
Le 11/08/2016 à 08:53

Merci Jean-Eric, c'est beaucoup plus rapide, maintenant c'est l'histoire de quelques secondes. Malheureusement il me place toujours des "0". Par la suite je souhaiterais faire des moyennes avec c'est données mais les zéros me gêne.

Le 11/08/2016 à 09:50

En fait j'ai agit sur la formule directement :

=MOYENNE.SI(Bilan_WP_FL!G2:G30;"<>0")

Petite question subsidiaire : Peux t'on automatiser deux actions sur deux boutons c'est à dire l'ouverture de la fiche par un formulaire et l'export des données ?

Formulaire :

Private Sub UserForm_Initialize()
Dim Plage As String
With Sheets("Base_ET")
    Plage = .Range("B2:B70" & .Range("A65536").End(xlUp).Row).Address
End With
ComboBox1.RowSource = "Base_ET!" & Plage
End Sub
Private Sub CommandButton1_Click()
 Sheets("Calcul FL").Range("A1") = ComboBox1
 Sheets("Calcul FL").Range("A1") = CDbl(ComboBox1)
 Unload mon_userform

End Sub

Export :

Option Explicit

Sub valider()
Dim wb As Workbook
Dim wst As Worksheet, wss As Worksheet
Dim re As Range
Dim dlt As Long
Dim ans As VbMsgBoxResult

    Set wb = ThisWorkbook
    Set wst = wb.Worksheets("Bilan_WP_FL")
    Set wss = wb.Worksheets("Fiche_FL")

    ' dernière ligne+1 de récap sera par défaut la ligne où l'on va sauver les données
   dlt = wst.Range("A" & wst.Rows.Count).End(xlUp).Row + 1
    ' on recherche le point dans Bilan_WP_FL
   Set re = wst.Range("A1:A" & dlt).Find(wss.Range("C1"), lookat:=xlWhole)
    ' si on la trouve
   If Not re Is Nothing Then
        ans = MsgBox("il existe déjà des données pour ce point, on les remplace ?", vbYesNo)
        If ans = vbYes Then
            ' on veut remplacer on mémorise la ligne à modifier
           dlt = re.Row
        Else
            'on ne veut pas remplacer, c'est fini
           GoTo exit_Handler
        End If
    End If
    ' à adapter
   ' copie des données de enregistrement vers recap, dans la ligne dlt
   wst.Range("A" & dlt) = wss.Range("C1")
   wst.Range("B" & dlt & ":L" & dlt) = Application.Transpose(wss.Range("D23:D33"))
   wst.Range("O" & dlt & ":Y" & dlt) = Application.Transpose(wss.Range("C23:C33"))
   wst.Range("AB" & dlt & ":AL" & dlt) = Application.Transpose(wss.Range("E23:E33"))
exit_Handler:
    Set wst = Nothing
    Set re = Nothing
    Set wss = Nothing
    Set wb = Nothing

End Sub

Merci

Rechercher des sujets similaires à "valeur macro"