Probléme de base de données sous excel

[viny123456789]

Resalut à tous un nouveau post pour les fêrus d'excel comme moi
mais qui sont justement meilleur que moi

Voila j'explique je vous joint un fichier sur lequel je bosse actuellement
il ce compose d'une base de données dans la feuil1 et d'une feuille de saisie feuil2

Je voudrais parvenir via la feuil2 d'integrer des nouveau enregistrement dans ma base de données exemple je saisie dans ma feuil2

Livre de francais code de 500 à 520 là normalement je lensse ma macro qui va sur la feuille 1 vas a la fin des données enregistrée dans ce cas précis il s'agit de la ligne 23 et integre les enregistrements :

500 | Francais | 1 | 20€
501 | Francais | 1 | 20€
502 | Francais | 1 | 20€

etc...


Merci d'avance pour votre aide .....

 

[zon]

Bonsoir à tous,


pour commencer tu peux essayer ce code

Sub Copie()
Dim W1 As Worksheet, W2 As Worksheet
Dim Intitule As String, Prix As String
Dim I As Integer, J As Integer
Set W1 = Sheets("Feuil1"): Set W2 = Sheets("Feuil2")
Intitule = W2.[B7]: Prix = W2.[B9]
On Error GoTo Sortie
For I = W2.[B3] To W2.[B4]
J = W1.[A65536].End(xlUp).Row + 1
W1.Range("A" & J) = I
W1.Range("B" & J) = Intitule
W1.Range("I" & J) = Prix
Next I
Sortie:
MsgBox "Le N° en B4 " & W2.[B4] & " est inferieur à celui de B3 " & W2.[B3]
End Sub



A+++

 

[viny123456789]

Bon g pas chercher à gener mais visiblement tu tes sentit attaquer par mon post qui demarrais par "Tout d'abord Merci pour ton aide" ce qui me semble somme toute assez polit.

Mais bon je me soumet volontier a la hierarchie plusque de toute façons g besoin de "ton" votre aide à tous pour avancer...

Tout d'abord Merci pour votre aide que tout le monde pourrais m'apporter.
Excuser votre humble élève de l'impolitesse diabolique dont il à fait preuve,

et je reprend tout de même:

Le code que tu ma fait parvenir et excelent mais il subsiste un prob il faudrait que je ne puisse ajouter une serie qu'une seule fois

exemple si j'ajoute les code de 500 à 550 la macro doit m'empecher d'ajouter le code de 530 à 540 sinon la base de donnée deviendra rapidement bourer de doublons...

Encore merci pour ton aide Salut....

 

[zon]

Re,


Effectivement j'ai pas pensé à souligner que tu étais poli=>je te présente mes excuses et à, mon tour je te dis MERCI.


Mais si tout le monde ouvrait un fil poour dire merci pour ensuite poser une question pour adapter une formule ou du code VBA alors le forum serait un vrai bordel...



Bon pour en revenir au code, je ne comprends plus grand chose à moins que tu nous ai pas tout dit.

Si 530 à 540 sont déjà saisis alors pourquoi mettre 500 à 550 ? alors que 500 à 530 puis 540 à 550 feront l'affaire...



A+++

 

[viny123456789]

(Pour formule de politesse voir plus haut)

Bon pour plus de detail le logiciel que je suis en train de mettre en place sera dans le futur utiliser par des gens (au cerveau de mouches) et il ne se passerat pas une journée sans que l'on m'appelle en me disant "je comprend pas il me retrouveee plus la ficheee" et il faudra toute les 10 secondes leur dire "mais c'est parceque tu à créer 2 fois les fiche tu comprends !!!"
bon je t'épargne la fin de cette conversation je crois que tu commence à comprendre le prob...

Le truc c'est que de la feuille 1 beaucoup de recherche depende et s'il y a des doublons mes recherche n'aboutirons plus...

Voila merci et à plus....

 

[zon]

Re,


Viny,


Sub Copie()
Dim W1 As Worksheet, W2 As Worksheet, C As Range
Dim Intitule As String, Prix As String
Dim I As Integer, J As Integer, K As Integer
Set W1 = Sheets("Feuil1"): Set W2 = Sheets("Feuil2")
Intitule = W2.[B7]
Prix = W2.[B9]
K = W1.[A65536].End(xlUp).Row
If W2.[B3] > W2.[B4] Then MsgBox "Le N° en B4 " & W2.[B4] & " est inferieur à celui de B3 " & W2.[B3]: Exit Sub
For I = W2.[B3] To W2.[B4]
With W1.Range("A1:A" & K)
Set C = .Find(I, LookIn:=xlValues)
End With
If C Is Nothing Then
J = W1.[A65536].End(xlUp).Row + 1
W1.Range("A" & J) = I
W1.Range("B" & J) = Intitule
W1.Range("I" & J) = Prix
End If
Next I
End Sub


A+++

 

[viny123456789]

Excusez moi g lacher l'ordi pour ce week end et je viens juste de mi remettre

Bon super maintenant sa marche nickel les données ne peuvent pas être inscrite en double.

Mais serait t'il possible lorsque un code en double est rencontrer dans informer l'utilisateur du style

Attention 1 ou plusieurs code que vous avez tenter d'inserer existe deja !!
Seul les codes inexistant ont êté inserer.

Bon et après c fini pour cette macro Merci pour tout....

 

[zon]

Bonjour à tous,

Viny essaie ceci,

Sub Copie()
Dim W1 As Worksheet, W2 As Worksheet, C As Range
Dim Intitule As String, Prix As String
Dim I As Integer, J As Integer, K As Integer
Set W1 = Sheets("Feuil1"): Set W2 = Sheets("Feuil2")
Intitule = W2.[B7]
Prix = W2.[B9]
K = W1.[A65536].End(xlUp).Row
If W2.[B3] > W2.[B4] Then MsgBox "Le N° en B4 " & W2.[B4] & " est inferieur à celui de B3 " & W2.[B3]: Exit Sub
For I = W2.[B3] To W2.[B4]
With W1.Range("A1:A" & K)
Set C = .Find(I, LookIn:=xlValues)
End With
If C Is Nothing Then
J = W1.[A65536].End(xlUp).Row + 1
W1.Range("A" & J) = I
W1.Range("B" & J) = Intitule
W1.Range("I" & J) = Prix
else Msgbox("Attention 1 ou plusieurs code que vous avez tenter d'inserer existe deja !! " & C & chr(13)&"Seul les codes inexistant ont êté inserer.")
End If
Next I
End Sub


A+++