implanter une variable sur 2 emplacement différents en fonction de la valeur d'une 2eme variable

Version imprimable

13/10/2018, 15h56
Slang

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

Bonjour Slang, bonjour le forum,

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

Code:

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:

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

15/10/2018, 21h26
Slang

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

Bonsoir,

Voila la macro sans intégration du point 1

Code:

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