base de données

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:

---

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

tu as essayé qqch avant de poster ?

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.

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

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:

---

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 :

Citation:

---

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.

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

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:

---

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

---

bonjour jacques_jean

Merci infiniment jacques_jean, c’est ce que je cherche vous m’avez bien aidé merci merci…

A bien Tôt:king:

Slts

Chaelo