IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

implanter une variable sur 2 emplacement différents en fonction de la valeur d'une 2eme variable [XL-2013]


Sujet :

Macros et VBA Excel

  1. #1
    Candidat au Club
    Homme Profil pro
    Chargé de développement industriel
    Inscrit en
    Octobre 2018
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Orne (Basse Normandie)

    Informations professionnelles :
    Activité : Chargé de développement industriel

    Informations forums :
    Inscription : Octobre 2018
    Messages : 3
    Par défaut implanter une variable sur 2 emplacement différents en fonction de la valeur d'une 2eme variable
    Bonjour,


    J'utilise une macro qui est fonctionnelle en l'état mais que je souhaiterais améliorer sur 2 points.
    La macro extrait des données d'un premier document excel pour les implanter dans un second.

    1er point :

    La première variable "alpha" est composé de 16 caractères (un mélange de lettres et de chiffres). Le 6eme caractère de "alpha" est toujours un chiffre, le but est que :
    si "alpha" est égal à 1 ou 3 au niveau du 6eme caractère, la variable "beta" est implanté dans la colonne "B"
    si "alpha" est égal à 5, 6 ou 7 au niveau du 6eme caractère, la variable "beta" est implanté dans la colonne "C"

    remarque : si "alpha" est égal à un autre chiffre au niveau du 6eme caractère, il n'y a pas de donnée pour la variable "beta".

    2eme point :


    Une 3eme variable "gamma" récupère un décimal mais dans le premier tableau il est présenté avec un point : "21.80" au lieu d'une virgule.
    Si je définis la variable "gamma" en tant que "String" la macro bug.
    Comment faire pour "gamma" soit bien considéré comme un décimal dans mon tableau de destination et avec une virgule ?

    Actuellement pour contourner le problème "gamma" est définit en tant que "String"

    Merci

  2. #2
    Membre Expert Avatar de Thautheme
    Homme Profil pro
    salarié
    Inscrit en
    Août 2014
    Messages
    1 373
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : salarié

    Informations forums :
    Inscription : Août 2014
    Messages : 1 373
    Par défaut
    Bonjour Slang, bonjour le forum,

    Pas sûr d'avoir bien compris...
    Point 1 :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    Sub Macro1()
    Dim COL As Byte
    Dim alpha As String
     
    Select Case Mid(alpha, 6, 1)
        Case "1", "3"
            COL = 2
        Case "5", "6", "7"
            COL = 3
        Case Else
            beta = ""
    End Select
    Cells(X, COL).Value = beta
    End Sub

    Point 2 :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    Public Sub Macro2()
    Dim gammaT As String
    Dim gamma As Double
     
    gammaT = Range("A1").Value
    gammaT = Replace(gammaT, ".", ",")
    gamma = CDbl(gammaT)
    Range("B1").Value = gamma
    End Sub

  3. #3
    Candidat au Club
    Homme Profil pro
    Chargé de développement industriel
    Inscrit en
    Octobre 2018
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Orne (Basse Normandie)

    Informations professionnelles :
    Activité : Chargé de développement industriel

    Informations forums :
    Inscription : Octobre 2018
    Messages : 3
    Par défaut
    Merci Thautheme.

    Le point 2 est réglé.

    Par contre je n'ai pas réussit à intégrer le code du point 1 dans ma macro.
    J'obtiens systématiquement une erreur sur la ligne 13

    Je vais essayer d'ajouter le code de la macro demain

  4. #4
    Candidat au Club
    Homme Profil pro
    Chargé de développement industriel
    Inscrit en
    Octobre 2018
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Orne (Basse Normandie)

    Informations professionnelles :
    Activité : Chargé de développement industriel

    Informations forums :
    Inscription : Octobre 2018
    Messages : 3
    Par défaut
    Bonsoir,

    Voila la macro sans intégration du point 1

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    Sub PRODENCOURS()
    '
    ' PRODENCOURS Macro
    '
     
    'Déclaration des variables
    Dim DateDuJour As Date
    Dim LigneProd As Integer
    Dim NumLigneExcel As Integer
    Dim NombreLignesRemplies As Integer
    Dim Alpha As String
    Dim Beta As String
    Dim An1 As String
    Dim An2 As String
    Dim An3 As String
    Dim Impression As String
    Dim Type As String
    Dim Couleur As String
    Dim GammaT As String
    Dim Gamma As Double
    Dim EpsilonT As String
    Dim Epsilon As Double
     
     
    Application.Workbooks.Open "z:\Data\Main.xlsx" ' Ouverture du fichier destinataire
     
    DateDuJour = Date
    LigneProd = 2
     
    For LigneProd = 2 To 33 
     
    Windows("PLANNING.xlsm").Activate
    Sheets("Planning2").Select
     
    If IsError(Application.Match(LigneProd, Range("A1:A1000"), 0)) Then ' si la ligne de prod n'existe pas, il ne se passe rien, seulement incrementation de Ligneprod de 1
     
    Else 'si la ligne de prod existe, le programme suivant est activé
     
    NumLigneExcel = Application.Match(LigneProd, Range("A1:A1000"), 0) ' recherche de numero de ligne de prod dans la colonne A (donc les lignes grises), et renvoi du numero de ligne du tableau excel
    NumLigneExcel = NumLigneExcel + 1 'on ajoute 1 pour arriver à la ligne sous la ligne grise avec le 1er lot.
     
    Alpha = Range("C" & NumLigneExcel).Value
    Beta = Range("E" & NumLigneExcel).Value
    An1 = Range("F" & NumLigneExcel).Value
    An2 = Range("G" & NumLigneExcel).Value
    An3 = Range("H" & NumLigneExcel).Value
    Impression = Range("D" & NumLigneExcel).Value
    Type = Range("AG" & NumLigneExcel).Value
    Couleur = Range("AD" & NumLigneExcel).Value
     
    GammaT = Range("AH" & NumLigneExcel).Value
    GammaT = Replace(GammaT, ".", ",") 'remplace le point dans la variable GammaT par une virgule
    Gamma = CDbl(GammaT) 'créer un double de la variable GammaT qui est un décimal alors que GammaT est considéré comme un texte
     
    EpsilonT = Range("AI" & NumLigneExcel).Value
    EpilonT = Replace(EpsilonT, ".", ",") 'remplace le point dans la variable EpsilonT par une virgule
    Epsilon = CDbl(EpsilonT) 'créer un double de la variable EpsilonT qui est un décimal alors que EpsilonT est considéré comme un texte
     
    Windows("Main.xlsx").Activate
    Sheets("Extraction planning").Select
     
    ' Faire la boucle JUSQU'A CE QUE la case de la colonne A soit vide i.e; rechercher la première ligne vide du tableau
    NombreLignesRemplies = 2
    Do Until Range("A" & NombreLignesRemplies).Value = ""
    NombreLignesRemplies = NombreLignesRemplies + 1
    Loop ' Fin de la boucle
     
    Range("A" & NombreLignesRemplies).Value = DateDuJour
    Range("B" & NombreLignesRemplies).Value = LigneProd
    Range("C" & NombreLignesRemplies).Value = Alpha
    Range("D" & NombreLignesRemplies).Value = Beta
     
    If An1 = "0" Then Range("E" & NombreLignesRemplies).Value = "" Else Range("E" & NombreLignesRemplies).Value = An1
    If An2 = "0" Then Range("F" & NombreLignesRemplies).Value = "" Else Range("F" & NombreLignesRemplies).Value = An2
    If An3 = "0" Then Range("G" & NombreLignesRemplies).Value = "" Else Range("G" & NombreLignesRemplies).Value = An3
     
    Range("I" & NombreLignesRemplies).Value = Impression
    Range("J" & NombreLignesRemplies).Value = Type
    Range("K" & NombreLignesRemplies).Value = Couleur
    Range("L" & NombreLignesRemplies).Value = Diametre
    Range("M" & NombreLignesRemplies).Value = Epaisseur
     
     
    End If
     
    Next
     
    Windows("Main.xlsx").Activate
     
    End Sub

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 4
    Dernier message: 15/09/2018, 13h49
  2. Réponses: 4
    Dernier message: 29/05/2012, 14h37
  3. Réponses: 5
    Dernier message: 21/12/2011, 08h31
  4. Réponses: 9
    Dernier message: 19/07/2011, 12h39
  5. Réponses: 2
    Dernier message: 01/04/2009, 11h17

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo