XL 2013 VBA Modifier info

Kidcarotte

XLDnaute Junior
Bonjour

J'ai cree une macro qui me permet d'ajouter des informations dans une database.
Par exemple; ma feuille 1 est compose de plusieurs champs: Nom prenom age sexe naissance...
Ma deuxieme feuille est la base de donnees.

J'ai cree trois boutons : Add new info ( je rentre les infos dans chaque champs et les ajoute a la database)
- Find : ( Chercher Mr Durand dans ma database de 430000 infos. Je precise il n'y a pas de possibilite de doublon dans ma database.)
- Clear ( effacer ce que j'ai actuellement cree

Maintenant, j'aimerais cree un bouton modifier. Par exemple, si lors de mon ajout d'info je me suis trompee sur la date de naissance, j'aimerais pouvoir la modifier.
Avez vous un code pour cela ?

Merci par avance
 

Robert

XLDnaute Barbatruc
Bonjour Kidcarotte, bonjour le forum,

À partir du moment que tu es en mesure de trouver (Find) quelqu'un dans la base c'est que tu connais son numéro de ligne. De là rien de plus simple de modifier la ligne. Si tu te donnais la peine de nous fournir un fichier exemple reprenant la structure de ta base, nous pourrions te proposer quelque chose de concret...
 

Kidcarotte

XLDnaute Junior
Bonjour Robert

Merci de votre reponse, je vous ai mis la table ci joint. Cela concerne des pieces detachees de voiture automobile. La base de donnees est sur la page deux. J'ai mis une base de donnees de 2 lignes ( supposement faire 43000 lignes)

Supposons, j'ai envie de changer la "part description" de la pieces ABCDE12345 qui est XX a YY, quelle serait la formule.
Car pour la find j'ai utilise une macro avec Vlookup

Merci

Cordialement
 

Pièces jointes

  • Proooojectr.xlsm
    36.3 KB · Affichages: 9

Robert

XLDnaute Barbatruc
Re,

La règle d'or en VBA c'est d'éviter autant que possible les Select et autres Activate inutiles !... Il ne font que ralentir l'exécution du code et sont source de plantage. En pièce jointe ton fichier modifié. Regarde combien le code est raccourci et aussi plus rapide. J'ai supprimé les formules dans le code et remplacé VLookup par une boucle sur une variable tableau qui est extrêmement rapide même sur un grand tableau.
Le code :

VB:
Private S1 As Worksheet
Private S2 As Worksheet
Private TV As Variant

Sub Add_New_Items()
Dim I As long

Set S1 = Worksheets("Sheet1")
Set S2 = Worksheets("Sheet2")
TV = S2.Range("A1").CurrentRegion
For I = 3 To UBound(TV, 1)
    If TV(I, 1) = S1.Range("A2") Then
        If MsgBox("Le code " & TV(I, 1) & " existe déjà ! Voulez-vous le rajouter ?", vbYesNo, "ATTENTION") = vbNo Then Exit Sub
    End If
Next I
S2.Rows(3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
S1.Range("A2:F2").Copy S2.Range("A3")
S1.Range("A5:D5").Copy S2.Range("G3")
S1.Range("A8:H8").Copy S2.Range("K3")
S1.Range("B11:G11").Copy S2.Range("S3")
S1.Range("B12:G12").Copy S2.Range("Y3")
S1.Range("B13:G13").Copy S2.Range("AE3")
S1.Range("B14:G14").Copy S2.Range("AK3")
S1.Range("B15:G15").Copy S2.Range("AQ3")
S1.Range("B16:G16").Copy S2.Range("AW3")
S1.Range("A19:F19").Copy S2.Range("BC3")
End Sub

Sub Clear()
Set S1 = Worksheets("Sheet1")
S1.Range("A2:F2, A5:D5, A8:H8, B11:G16, A19:F19").ClearContents
End Sub

Sub lookup()
Dim I As long

Set S1 = Worksheets("Sheet1")
Set S2 = Worksheets("Sheet2")
TV = S2.Range("A1").CurrentRegion
For I = 3 To UBound(TV, 1)
    If TV(I, 1) = S1.Range("A2").Value Then
        S1.Range("B2").Resize(1, 5).Value = S2.Cells(I, "B").Resize(1, 5).Value
        S1.Range("A5").Resize(1, 4).Value = S2.Cells(I, "G").Resize(1, 4).Value
        S1.Range("A8").Resize(1, 8).Value = S2.Cells(I, "K").Resize(1, 8).Value
        S1.Range("B11").Resize(1, 6).Value = S2.Cells(I, "S").Resize(1, 6).Value
        S1.Range("B12").Resize(1, 6).Value = S2.Cells(I, "Y").Resize(1, 6).Value
        S1.Range("B13").Resize(1, 6).Value = S2.Cells(I, "AE").Resize(1, 6).Value
        S1.Range("B14").Resize(1, 6).Value = S2.Cells(I, "AK").Resize(1, 6).Value
        S1.Range("B15").Resize(1, 6).Value = S2.Cells(I, "AQ").Resize(1, 6).Value
        S1.Range("B16").Resize(1, 6).Value = S2.Cells(I, "AW").Resize(1, 6).Value
        S1.Range("A19").Resize(1, 6).Value = S2.Cells(I, "BC").Resize(1, 6).Value
    End If
Next I
End Sub

Sub Modify()
Dim I As Long
Dim LI As Long

Set S1 = Worksheets("Sheet1")
Set S2 = Worksheets("Sheet2")
TV = S2.Range("A1").CurrentRegion
For I = 3 To UBound(TV, 1)
    If TV(I, 1) = S1.Range("A2").Value Then
        LI = I
        Exit For
    End If
Next I
S1.Range("A2:F2").Copy S2.Cells(LI, "A")
S1.Range("A5:D5").Copy S2.Cells(LI, "G")
S1.Range("A8:H8").Copy S2.Cells(LI, "K")
S1.Range("B11:G11").Copy S2.Cells(LI, "S")
S1.Range("B12:G12").Copy S2.Cells(LI, "Y")
S1.Range("B13:G13").Copy S2.Cells(LI, "AE")
S1.Range("B14:G14").Copy S2.Cells(LI, "AK")
S1.Range("B15:G15").Copy S2.Cells(LI, "AQ")
S1.Range("B16:G16").Copy S2.Cells(LI, "AW")
S1.Range("A19:F19").Copy S2.Cells(LI, "BC")
End Sub

Le fichier :
 

Pièces jointes

  • Kidcarrotes_ED_v01.xlsm
    32.8 KB · Affichages: 7

Statistiques des forums

Discussions
294 412
Messages
1 938 345
Membres
188 791
dernier inscrit
aloha1234