Discussion :

[chaelo]

Bonjour,

J’ai trouvé le code suivant dans un Forum allemand, il permet transfert des données d un classer á un autre classeur (base de données) fermé.
J’aimerais bien que ce code soit changé de telle façons que si les données existe déjà il les actualise et si ces donnée n’existe pas qu’il les rajoute a partir de la dernier ligne.
Le 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
Sub x()
Dim arr(5) As Variant
Dim RanFree As Integer
Dim wks As Workbook
 
'**************************************
'*** Hier muß dein Drucken Code hin ***
'**************************************
 
arr(0) = [E2]
arr(1) = [I2].Text
arr(2) = [D5]
arr(3) = [I5]
arr(4) = [D7]
arr(5) = [I7]
 
Set wks = Workbooks.Open("C:\Muster\Auswertung.xls") ' <--- Pfad anpassen
 
RanFree = wks.Worksheets(1).Range("A65536").End(xlUp).Row + 1
 
wks.Worksheets(1).Cells(RanFree, 1) = arr(0)
wks.Worksheets(1).Cells(RanFree, 2) = arr(0)
wks.Worksheets(1).Cells(RanFree, 3) = arr(1)
wks.Worksheets(1).Cells(RanFree, 4) = arr(2)
wks.Worksheets(1).Cells(RanFree, 5) = arr(3)
wks.Worksheets(1).Cells(RanFree, 6) = arr(4)
wks.Worksheets(1).Cells(RanFree, 7) = arr(5)
wks.Save
wks.Close
 
End Sub

merci d'avance et Slts

Chaelo

[Commodore]

tu as essayé qqch avant de poster ?

[Invité]

Bonjour Chaelo,

Le problème ne semble pas à priori très compliqué sauf qu'il reste à savoir sur quelle données la comparaison peut se faire pour déterminer si l'on doit :

-actualiser la dernière ligne (ou une autre ?)
-ou créer une nouvelle ligne.

[chaelo]

Bonjour,

Ci-joint un exemple, le formulaire réclamation me permet de remplier une fiche de réclamation et de l’enregistrer sous un dossier du client, avec le bouton Transfer je transfère mes donné au classeur Auswertung qui me permet de faire une liste de toute les réclamations et leurs situation.

La comparaison doit ce faire dans la colonne A. si le numéro existe déjà il faut alors soit remplacé toute la ligne ou remplir les cellules vides (Actualisation donc), si le numéro n’existe pas donc ajouté une ligne et ainsi de suite.

Merci pour votre aide.

Mes Slts

Chaelo

[Invité]

Bonjour Chaelo,

Voici le code que j'ai mis dans votre module1 (en conservant votre façon de procéder) et que j'ai testé :

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
Sub x()
Dim arr(8) As Variant
Dim RanFree As Integer
Dim wks As Workbook
Dim n As Integer, n1 As Integer
Dim mnum
'**************************************
'*** Hier muß dein Drucken Code hin ***
'**************************************
 
arr(0) = Worksheets(2).[E9]
arr(1) = Worksheets(2).[E13]
arr(2) = Worksheets(2).[E16]
arr(3) = Worksheets(2).[E20]
arr(4) = Worksheets(2).[E24]
arr(5) = Worksheets(2).[E28]
arr(6) = Worksheets(2).[E32]
arr(7) = Worksheets(2).[E36]
 
Set wks = Workbooks.Open("C:\Muster\Auswertung.xls") ' <--- Pfad anpassen
 
RanFree = wks.Worksheets(1).Range("A65536").End(xlUp).Row + 1
For n = 2 To RanFree - 1
mnum = wks.Worksheets(1).Cells(n, 1)
    If mnum = arr(0) Then
        For n1 = 2 To 8
        wks.Worksheets(1).Cells(RanFree, n1) = arr(n1 - 1)
        Next n1
    wks.Save
    wks.Close
    Exit Sub
    End If
    Next n
 
For n1 = 1 To 8
wks.Worksheets(1).Cells(RanFree, n1) = arr(n1 - 1)
Next n1
wks.Save
wks.Close
End Sub

Remarque : au départ vous avez écrit :

J’ai trouvé le code suivant dans un Forum allemand, il permet transfert des données d un classer á un autre classeur (base de données) fermé.

J'avais donc cru comprendre que vous vouliez mettre à jour ce 2ème classeur sans l'ouvrir.
Mais comme dans votre code il y a l'instruction qui ouvre votre classeur, je n'ai pas modifié.

Amicalement.

[chaelo]

Bonjour jacques_jean,

Votre proposition me permet de rajouter une deuxieme ligne, sans la valeur de celulle E9(reclamation.xls) dans la cologne A du tableau Auswertung.xls.
ce que je veux c'est que le code doit verifier la cologne A du classeur Auswertung.xls et voir si la valeur E9 (de reclamation.xls) existe:
si oui il doit actualiser cette meme ligne.
si non il doit rajouter ces données au tableau.


merci pour votre aide.

Chaelo

[Invité]

Bonjour Chaelo,

En effet il y avait une anomalie. Je n'ai pas compris pourquoi mon 1er essai avait fonctionné.

Toutes mes excuses.

Ci-dessous le code rectifié (seule la variable en rouge a été rectifiée)

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
Sub x()
Dim arr(8) As Variant
Dim RanFree As Integer
Dim wks As Workbook
Dim n As Integer, n1 As Integer
Dim mnum
'**************************************
'*** Hier muß dein Drucken Code hin ***
'**************************************
 
arr(0) = Worksheets(2).[E9]
arr(1) = Worksheets(2).[E13]
arr(2) = Worksheets(2).[E16]
arr(3) = Worksheets(2).[E20]
arr(4) = Worksheets(2).[E24]
arr(5) = Worksheets(2).[E28]
arr(6) = Worksheets(2).[E32]
arr(7) = Worksheets(2).[E36]
 
Set wks = Workbooks.Open("C:\Muster\Auswertung.xls") ' <--- Pfad anpassen

RanFree = wks.Worksheets(1).Range("A65536").End(xlUp).Row + 1
For n = 2 To RanFree - 1
mnum = wks.Worksheets(1).Cells(n, 1)
    If mnum = arr(0) Then
        For n1 = 2 To 8
        wks.Worksheets(1).Cells(n, n1) = arr(n1 - 1)
        Next n1
    wks.Save
    wks.Close
    Exit Sub
    End If
    Next n
    
For n1 = 1 To 8
wks.Worksheets(1).Cells(RanFree, n1) = arr(n1 - 1)
Next n1
wks.Save
wks.Close
End Sub