Discussion :

[lele79]

Bonjour ou bonsoir a tous,

je suis nouveau dans le forum et je me permets de solliciter votre aide, merci d'avance.

Je ne suis pas famillier avec les langages de programmation, encore moins avec VB mais la je suis dans l'obligation de comprendre VB et de l'utiliser dans le cadre de mon travail.
Tous ce que je sais faire de VB c'est de faire des macros avec l'enregistreur macros.

Dans mon projet, je dois copier des elements contenus dans une colonne, apporter quelques changements et le coller dans une feuille d'un autre classeur.
voici-ci joints un exemple de ce que je veux faire:
- Je copier tous ce qui est dans la colonne A de la feuille 1, classeur 1, et je rajoute un "_x" (x represente en faite un mot qui sera la meme pour tous) et ensuite je les colles dans la feuille 1 du classeur 2. Et lors que je colle sur ce dernier il faut que les lignes se suivent l'un derriere l'autre.

voila, je ne sais si tous est clair mais n'hesiter a me solliciter pour plus d'info.

merci.

Lele79

[delphine35]

Je ne sais pas si c'est ce que tu veux (j'ai peut etre pas tout compris) :

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
Sub lance()
 
Dim val1  As Integer
 
 
Set w1 = Worksheets(1)
Set w2 = Worksheets(2)
 
DerniereLigneRenseigné = w1.Cells(65000, 7).End(xlUp).Row
 
j = 1
 
For i = 2 To DerniereLigneRenseigné
 
    Set C1 = w1.Cells(i, 1)
 
    If C1.Value > "" Then
 
' Suite du traitement de la ligne précente de la feuille 2
 
        If j > 1 Then
            w2.Cells(j, 4).Value = w2.Cells(j, 4).Value & C1.Offset(-1, 6)
        End If
 
' Traitement de la nouvelle ligne de la feuille 2
 
        j = j + 1
 
        w2.Cells(j, 1).Value = C1 & "_x"
        w2.Cells(j, 2).Value = C1.Offset(0, 1)
        w2.Cells(j, 3).Value = C1.Offset(0, 5)
        w2.Cells(j, 4).Value = C1 & ":"
        val1 = C1.Offset(0, 2).Value - C1.Offset(0, 3).Value
        w2.Cells(j, 5).Value = val1
        w2.Cells(j, 6).Value = val1 / 2
 
    End If
 
Next i
 
'Derniere ligne
w2.Cells(j, 4).Value = w2.Cells(j, 4).Value & w1.Cells(i - 1, 7)
 
End Sub

[lele79]

Merci beaucoup Delphine!

c'est exactement ca que je veux faire!. Par contre je voudrai faire l'echange sur deux classeur differente.
copier colonnes et modif de la Feuille1, classeur1 => coller sur la feuille1 classeur 2 , en meme temps pourrais-je avoir une explication rapide sur chaque ligne de code, SVP!.

en vous remerciant ainsi que ce forum.

Cordialement,

Lele79

[lele79]

Bonjour delphine, j'ai change ca pour avoir ce que j'esperais.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set w1 = Workbooks(1).Sheets(1)
Set w2 = Workbooks(2).Sheets(1)

Egalement, a chaque fois que je lance la macro, j'ai un message:

"Run-Time error'13'

qu'es ce que cela veux dire?

Cordialement,

Lele79

[lele79]

Bonjour a tous,

Desole mais je suis partie sur un autre piste.

D'autres personnes m'ont aide dans le forum "Excel Download" et je les en remercie. Voici un bout de code qu'ils m'ont donne. j'ai garde la meme procedure pour avoir les autres colonnes.
J'ai pris ce code car je le trouve plus comprehensible, enfin pour moi, car celui que delphine cela me semble compliquer.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Dim cel As Range, d As Range
Set d = Workbooks(2).Sheets(1).[A1]
'Pour chaque cellule de la zone utile où y a pas de cellule vide :
  For Each cel In Workbooks(1).Sheets(1).Range([A1], [A65535].End(xlUp)).SpecialCells(xlCellTypeConstants, 23) 
            d = cel & "_Value"        
Set d = d.Offset(1, 0)
  Next
End Sub

Maintenant , comment pourrais-je avoir l'element suivant:
A la feuille 1, classeur 1: Chaque "Nom" (colonne "Nom") est assoicie 3 types de propriete (colonne "Propriete). Exemple: A -> g, h, i.

Je voudrai avoir sur le classeur 2, le resultats suivant a la colonne"Tag" l'un a suitre de l'autre:
- A &"_"& g
- A &"_"& h
- A &"_"& i
- B &"_"& h
- B &"_"& i
- B &"_"& J
........


EN vous remerciant par avance,

Lele79

[lele79]

Bonjour a tous,

es ce que ce j'ai poste au dessus est faisable ?

Merci par avance,

Lele79

[Invité]

Bonjour,

Dans votre fichier exemple, la colonne "nom" n'est renseignée que lorsque le nom change. Est-ce vraiment le cas en réalité ?

[lele79]

Bonjour Jacques Jean, le forum,

Dans votre fichier exemple, la colonne "nom" n'est renseignée que lorsque le nom change. Est-ce vraiment le cas en réalité ?

Effectivement. cette colonne se remplis tous seul et les noms ne seront jamais les memes!

Cordialement,

Lele79.

[PPz78]

Bonjour,

Même en corrigeant les fautes d'orthographe, ton besoin n'est pas clair :

Je voudrais avoir sur le classeur 2, le resultats suivant à la colonne"Tag" l'un à suite de l'autre:
- A &"_"& g
- A &"_"& h
- A &"_"& i

le résultat souhaité dans la colonne TagInstrum est-il

A &"_"& g A &"_"& h A &"_"& i avec les "" et les & ou

A_g A_h A_i ou encore

A_g
A_h
A_i en colonne dans la même cellule

ou autre chose

Nota : dans le fichier exemple fourni initialement il n'y a que : A&"_"&i

PPz

[lele79]

Bonjour PPz78, le forum,

effectivement cela peut porter a confusion et je m'en excuse. Votre citation est egalement vrai dans mon cas....bien vue! donc j'ai plutot interet a formuler une requete bien claire.
Quant a mes fautes d'orthographe...je n'ai pas d'excuse! un peu de precipitation peut etre et quant aux accents, j'ai un ordi anglophone et je n'ai pas fais les raccourcis pour les accents....

En tout cas, j'ai modifie le premier fichier de mon premier post pour vous montrer les differentes resultats escomptees.
Il est vrai, qu'il n'a rien a voir avec ma requete de mon dernier post mais je ne voulais pas trop surcharger ma demande. Ainsi lors de mon dernier post je demandais:
Je voudrai avoir sur le classeur 2, le resultats suivant a la colonne"Tag" l'un a suitre de l'autre la chose suivante:

Je voudrai avoir sur le classeur 2, le resultats suivant a la colonne"Tag" l'un a suitre de l'autre:
- A &"_"& g
- A &"_"& h
- A &"_"& i
- B &"_"& h
- B &"_"& i
- B &"_"& J
........

le but en fait, etait d'avoir un bout de code me permettant d'obtenir le resultat suivant:
A_g
A_h
A_i
.....

meme si ce n'est pas je que je voulais au final mais au moins j'aurais la syntaxe me permettant de continuer mon projet et d'obtenir le tableau final.

EN tout cas merci de preter attention a mes posts.

Cordialement,

lele79

[PPz78]

Salut,

Ceci devrait faire l'affaire

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
Sub Calcul_Book2()
'
'   Calcul de Book2, qui est supposé ouvert
    Book1 = "Book1.xls"
    Book2 = "Book2.xls"
  ' Dernière ligne
    DerniereLigne = Workbooks(Book1).Sheets("Feuil1").Cells(65532, 7).End(xlUp).Row
    MsgBox (DerniereLigne)
  ' RaZ de Book2
    Windows(Book2).Activate
    Cells.Select
    Selection.Clear
  ' En-tête de Book2
    Cells(1, 1) = "Tag"
    Cells(1, 2) = "Description"
    Cells(1, 3) = "Unite"
    Cells(1, 4) = "TagInstrum"
    Cells(1, 5) = "Span"
    Cells(1, 6) = "Typical value"
  ' Boucle de lecture
        I_lig2 = 1
        I_lig1 = 1
    Do
        I_lig1 = I_lig1 + 1
        Nom = Workbooks(Book1).Sheets("Feuil1").Cells(I_lig1, 1)
        Des = Workbooks(Book1).Sheets("Feuil1").Cells(I_lig1, 2)
        Max = Workbooks(Book1).Sheets("Feuil1").Cells(I_lig1, 3)
        Min = Workbooks(Book1).Sheets("Feuil1").Cells(I_lig1, 4)
        Fra = Workbooks(Book1).Sheets("Feuil1").Cells(I_lig1, 5)
        Uni = Workbooks(Book1).Sheets("Feuil1").Cells(I_lig1, 6)
        Pro = Workbooks(Book1).Sheets("Feuil1").Cells(I_lig1, 7)
        Typ = Workbooks(Book1).Sheets("Feuil1").Cells(I_lig1, 8)
 
        If Pro <> "" And Nom <> "" Then      ' Nouvelle ligne compléte
          ' Ecriture de la nouvelle ligne dans Book2
            I_lig2 = I_lig2 + 1
            Nom_Courant = Nom
                Complément = ""
            If Pro = "g" Then Complément = "_x"
            If Pro = "h" Then Complément = "_y"
            If Pro = "i" Then Complément = "_z"
            Cells(I_lig2, 1) = Nom_Courant & Complément
            Cells(I_lig2, 2) = Des
            Cells(I_lig2, 3) = Uni
            Cells(I_lig2, 4) = Nom_Courant & ":" & Pro
            Cells(I_lig2, 5) = Min & " - " & Max
            Cells(I_lig2, 6) = (Max + Min) * 0.5
        End If
 
        If Pro <> "" And Nom = "" Then      ' Nouvelle ligne partielle
          ' Ligne avec le même nom
            I_lig2 = I_lig2 + 1
                Complément = ""
            If Pro = "g" Then Complément = "_x"
            If Pro = "h" Then Complément = "_y"
            If Pro = "i" Then Complément = "_z"
            Cells(I_lig2, 1) = Nom_Courant & Complément
            Cells(I_lig2, 4) = Nom_Courant & ":" & Pro
        End If
 
        MsgBox (Nom)
 
        If I_lig1 > DerniereLigne Then Exit Do
    Loop

PPz

[lele79]

Bonjour PPz 78, le forum,

Excelent, ca marche nickel !... je vous remercie beaucoup ainsi que ce forum.

Je vais desormais clore ce chapitre.

Encore une fois merci pour votre disponibilite.

Cordialement,

Lele79

[lele79]

Bonjour PPz78, le forum

J'ai bien avance avec ton programme PPz78 et je t'en remercie pour ton aide. je reviens encore sur ce post car j'ai des modifications sur mon tableau de depart et je n'arrive pas a obtenir le resultats escomptes.
Je vous joins le fichier avec la modife apportee ainsi que le resultats que je voudrai obtenir.

En vous remerciant par avance.

lele79

[PPz78]

Bonsoir,

Voici une autre version du code. Il faut faire attention celle ci a été modifiée sur une machine anglaise, il faut peut être changer Sheet en Feuil
A+

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
Sub Calcul_Book2()
'
'   Calcul de Book2, qui est supposé ouvert
    Book1 = "Book1b_1.xls"
    Book2 = "Book1b_2.xls"
    Feuil = "Feuil1"           ' Attention au nom des feuilles du classeur
    Feuil = "Sheet1"           ' Attention au nom des feuilles du classeur
  ' Dernière ligne
    DerniereLigne = Workbooks(Book1).Sheets(Feuil).Cells(65532, 9).End(xlUp).Row
    MsgBox (DerniereLigne)
  ' RaZ de Book2
    Windows(Book2).Activate
    Cells.Select
    Selection.Clear
  ' En-tête de Book2
    Cells(1, 1) = "Tag"
    Cells(1, 2) = "Description"
    Cells(1, 3) = "Unite"
    Cells(1, 4) = "TagInstrum"
    Cells(1, 5) = "Span"
    Cells(1, 6) = "Typical value"
  ' Boucle de lecture et écriture
        I_lig2 = 1
        I_lig1 = 2
    Do
       ' Lecture
        I_lig1 = I_lig1 + 1
        Pro = Workbooks(Book1).Sheets(Feuil).Cells(I_lig1, 9)
        Typ = Workbooks(Book1).Sheets(Feuil).Cells(I_lig1, 10)
        If Typ <> "" And Pro <> "" Then      ' Nouvelle ligne compléte
          ' Mémorisation de Nom, description, Min, Max et Unités
        Nom = Workbooks(Book1).Sheets(Feuil).Cells(I_lig1, 1)
        Des = Workbooks(Book1).Sheets(Feuil).Cells(I_lig1, 2)
        Maxg = Workbooks(Book1).Sheets(Feuil).Cells(I_lig1, 3)
        Ming = Workbooks(Book1).Sheets(Feuil).Cells(I_lig1, 4)
        Unig = Workbooks(Book1).Sheets(Feuil).Cells(I_lig1, 5)
        Maxh = Workbooks(Book1).Sheets(Feuil).Cells(I_lig1, 6)
        Minh = Workbooks(Book1).Sheets(Feuil).Cells(I_lig1, 7)
        Unih = Workbooks(Book1).Sheets(Feuil).Cells(I_lig1, 8)
        End If
 
       ' Ecriture de la nouvelle ligne dans Book2
            Nom_Courant = Nom
            Complément = ""
            Max = ""
            Min = ""
            uni = ""
        If Pro = "g" Then
            Complément = "_x"
            Max = Maxg
            Min = Ming
            uni = Unig
        End If
        If Pro = "h" Then
            Complément = "_y"
            Max = Maxh
            Min = Minh
            uni = Unih
        End If
        If Pro = "i" Then Complément = "_z"
 
        If Pro <> "" Then
            I_lig2 = I_lig2 + 1
            Cells(I_lig2, 1) = Nom_Courant & Complément
            Cells(I_lig2, 2) = Des & "_" & Pro
            Cells(I_lig2, 3) = uni
            Cells(I_lig2, 4) = Nom_Courant & ":" & Pro
            If Min = "" Or Max = "" Then
                Cells(I_lig2, 5) = "  "
                Cells(I_lig2, 6) = ""
            Else
                Cells(I_lig2, 5) = "  " & Min & " - " & Max
                Cells(I_lig2, 6) = (Max + Min) * 0.5
            End If
        End If
 
        MsgBox (Nom)
 
        If I_lig1 > DerniereLigne Then Exit Do
    Loop
End Sub

[lele79]

Bjr PPz78, le forum,

Merci beaucoup PPz78, vous m'avez enormement aide et je vous en suis reconnaissant, merci beaucoup.
Ca marche nickel.
D'autres elements de mon tableau ont evolue et il faut que je reajuste le code. Je n'ai pas trop touche au code, j'ai juste enleve la declaration des entetes du deuxieme tableau, car ceci sont fixes.
j'ai apporte trois ligne de code permettant de prendre en compte la nouvelles donne afin d'obtenir le tableau escompte.
Cette modife concerne la fonction FIND. Elle me cherche "HK" dans la premiere colonne lorsque Pro="" si elle trouve alors prendre la valeur True est ecrit dans le resultat de Instrumentag dans le tableau de l'autre feuille.

Code:

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
 Sub Calcul_Book2()
'
'   Calcul de Book2, qui est supposé ouvert
  Set w1 = Workbooks("test").Sheets(1)
  Set w2 = Workbooks("Book2").Sheets(1)
    ' Dernière ligne
    DerniereLigne = w1.Cells(65532, 9).End(xlUp).Row
   ' MsgBox (DerniereLigne)
 
  ' Boucle de lecture et écriture
       i = 3
       j = 1
    Do
       ' Lecture
        i = i + 1
        pro = w1.Cells(i, 9)
        Typ = w1.Cells(i, 10)
 
        If Typ <> "" And pro <> "" Then      ' Nouvelle ligne compléte
          ' Mémorisation de Nom, description, Min, Max et Unités
        nom = w1.Cells(i, 1)
        Des = w1.Cells(i, 2)
        Maxg = w1.Cells(i, 3)
        Ming = w1.Cells(i, 4)
        Unig = w1.Cells(i, 5)
        Maxh = w1.Cells(i, 6)
        Minh = w1.Cells(i, 7)
        Unih = w1.Cells(i, 8)
 
        End If
 
        ' Ecriture de la nouvelle ligne dans Book2
            Nom_Courant = nom
            Complément = ""
            Max = ""
            Min = ""
            uni = ""
 
 
        If pro = "g" Then
            Complément = "_x"
            Max = Maxg
            Min = Ming
            uni = Unig
 
        End If
        If pro = "h" Then
            Complément = "_y"
            Max = Maxh
            Min = Minh
            uni = Unih
 
        End If
        If pro = "i" Then Complément = "_z"
 
 
         If pro = "" Then
                 nam = w1.Cells(i, 1)
            If Not w1.Cells(i, 1).Find("HK") Is Nothing Then ' And Not w1.Cells(i + 1, 1).Find("MM0") Is Nothing Then
                nam_Inst = nam & "/"
            End If
        End If
        If pro <> "" Then
       ' nam_Inst = ""
            j = j + 1
            w2.Cells(j, 1) = Nom_Courant & Complément
            w2.Cells(j, 2) = Des & "_" & pro
            w2.Cells(j, 3) = uni
            w2.Cells(j, 4) = nam_Inst & Nom_Courant & ":" & pro
 
            If Min = "" Or Max = "" Then
               w2.Cells(j, 5) = "  "
                w2.Cells(j, 6) = ""
            Else
                w2.Cells(j, 5) = Max - Min
                w2.Cells(j, 6) = (Max + Min) * 0.5
            End If
           ' nam_Inst = ""
        End If
       '
       ' MsgBox (Nom)
 
        If i > DerniereLigne Then Exit Do
    Loop
End Sub

Je vous joins egalement le fichier pour plus de comprehension. le code est egalement dans le fichier. les bouts de lignes que j'ai joins sur le code fonctionne mais je n'arrive pas a le reinitialise pour ne plus etre actif.
Ensuite a la fin des tranferts des donnes, je voudrai faire une comparaison !.


Merci d'avance pour vos aides,

cordialement,

Lele79

[PPz78]

Bonjour,

je n'arrive pas a le reinitialise pour ne plus etre actif

merci de me traduire .

PPz

[lele79]

Bonjour PPz78, le forum.

En fait je veux reinitialiser (vider) la valeur de nam_Inst lorsque la condition FIND ne trouve plus de "HK".
car la facon dans j'ai presente mon bout de condition, nam_Inst garde en memoire la derniere valeur True de la condition Find. c'est pour ca qu'avec le traitement de la ligne 22 du premier tableau.
le resultat sur Taginstrum dans l'autre classeur est fausse, on obtient :
KLJ_HK/B:g KLJ_HK/B:h KLJ_HK/B:imais ce que j'esperai est :
B:g
B:h
B:i

voila, si ce n'est pas claire redites le moi et j'esserai d'expliquer mieux. Je pense qu'avec le fichier depose precedamment explique mieux mon souci.

en cous remerciant,

lele79

[lele79]

BOnjour PPz78, le forum

voici la condition que j'ai rajoute et que j'ai ecris differemment par rapport au code depose precedemment:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
If pro = "" Then
         nam = w1.Cells(i, 1).find("HK")
            If Not nam Is Nothing Then 
                nam_Inst = nam & "/"
            End If
        End If

Je cherche en fait a vider nam_Inst="" une fois que la condition n'est plus respecte . J'ai essaye de le mettre un peu par tout dans la boucle mais cela ne change rien. Je n'obtiens toujours pas ce que j'esperais .
Mais bon, je ne desespere pas il faut continuer, il n'y a pas le choix.

cordialement,

lele79

[PPz78]

Salut

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
IF   .......   Then 
'    code
Else
'    code
Endif

Ne ferait-il pas l'affaire.

PPz

[mercatog]

Bonjour,
Une intrusion au sujet
Edit:

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
Sub Calcul_Book2()
Dim W1 As Worksheet, W2 As Worksheet
Dim DerniereLigne As Long, i As Long, j As Long
Dim Pro As String, Typ As String, Nom As String, Des As String, UniG As String, UniH As String, Uni As String
Dim Nam As String, Nam_Inst As String, Complement As String
Dim MaxG As Double, MinG As Double, MaxH As Double, MinH As Double, Max As Double, Min As Double
 
 
'   Calcul de Book2, qui est supposé ouvert
Set W1 = Workbooks("test.xlsm").Sheets(1)
Set W2 = Workbooks("Book2.xlsm").Sheets(1)
DerniereLigne = W1.Cells(W1.Rows.Count, 9).End(xlUp).Row
 
j = 1
For i = 4 To DerniereLigne
    Pro = W1.Cells(i, 9)
    Typ = W1.Cells(i, 10)
    If Typ <> "" And Pro <> "" Then          ' Nouvelle ligne compléte
        Nom = W1.Cells(i, 1)
        Des = W1.Cells(i, 2)
        MaxG = W1.Cells(i, 3)
        MinG = W1.Cells(i, 4)
        UniG = W1.Cells(i, 5)
        MaxH = W1.Cells(i, 6)
        MinH = W1.Cells(i, 7)
        UniH = W1.Cells(i, 8)
        Nam = W1.Cells(i - 1, 1)
        Nam_Inst = IIf(InStr(Nam, "HK") > 0, Nam & "/", "")
    End If
    Select Case Pro
        Case "g"
            Complement = "_x"
            Max = MaxG
            Min = MinG
            Uni = UniG
        Case "h"
            Complement = "_y"
            Max = MaxH
            Min = MinH
            Uni = UniH
        Case "i"
            Complement = "_z"
            Max = 0
            Min = 0
            Uni = ""
    End Select
 
    If Pro <> "" Then
        j = j + 1
        W2.Cells(j, 1) = Nom & Complement
        W2.Cells(j, 2) = Des & "_" & Pro
        W2.Cells(j, 3) = Uni
        W2.Cells(j, 4) = Nam_Inst & Nom & ":" & Pro
        If Min <> 0 Or Max <> 0 Then
            W2.Cells(j, 5) = Max - Min
            W2.Cells(j, 6) = (Max + Min) * 0.5
        End If
    End If
Next i
Set W1 = Nothing
Set W2 = Nothing
End Sub