XL 2013 VBA - Croiser des données et injecter des lignes

[Arnaud81]

Bonjour,

Je n'y connais vraiment pas grand chose en VBA... Si quelqu'un pouvait m'aider ce serait top (mon patron me met la pression!!)

Dans le fichier Excel joint, j'ai trois onglets :

• Correspondance V1 V2 : onglet de données sources
  
• Source : onglet tel qu'il est actuellement et que je souhaite modifier
• Cible : Liste que je souhaiterais obtenir à partir des deux onglets précédents.

Exemple avec la fonction A : Je souhaiterais avoir une macro qui

• dans mon onglet source repère le nombre de lignes par fonction V1 (colonne D - ici 6 lignes),
• crée les 5 lignes manquantes par insertion,
• rapatrie de l'onglet Correspondance V1 V2 les 6 fonctions V2 (A1; A2; ...; A6)

Hypothèses :

• 7000 lignes dans l'onglet V1 V2
• 15 onglets cibles (mais je peux appliquer la macro de facon manuelle pour chaque onglet

Merci d'avance pour vos réponses

Arnaud

 

[Arnaud81]

J'ai commencé avec ce bout de code pour insérer des lignes mais cela bloque sur c.Offset(0, -3).Value = c.Offset(0, -3).Value / c.Value

Sub Test()
Dim DerLig As Long
Application.ScreenUpdating = False
With Worksheets("Données de départ")
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
For i = DerLig To 2 Step -1
Set c = .Range("D" & i)
If Not IsEmpty(c) Then
If IsNumeric(c) Then
c.Offset(0, -3).Value = c.Offset(0, -3).Value / c.Value
c.Offset(0, -2).Value = c.Offset(0, -2).Value / c.Value
c.Offset(0, -1).Value = c.Offset(0, -1).Value / c.Value
Set MaPlage = .Range(.Cells(i, "A"), .Cells(i, "F"))
For j = 1 To c.Value - 1
.Range("G" & i).EntireRow.Insert
.Range(.Cells(i, "A"), .Cells(i, "F")) = MaPlage.Value
Next j
c.ClearContents
End If
End If
Next
End With
Application.ScreenUpdating = True
End Sub

 

[Nairolf]

Salut,

Essaye avec le code suivant (à noter que je n'ai rapatrié que les colonnes extrêmes car les colonnes intermédiaires sont sur le même principe que la première colonne) :

Sub V1V2()

'Définition des variables
Dim NbFonction As Integer
Dim i As Integer
Dim j As Integer
Dim NbOccurenceV2 As Integer
Dim Compteur1 As Integer
'/Définition des variables

'Initialisation
NbFonction = Application.WorksheetFunction.CountA(Worksheets("Source").Range("A:A")) - 1
Compteur1 = 1
'/Initialisation

For i = 1 To NbFonction 'Boucle sur le nombre de fonctions
  
    NbOccurenceV2 = Worksheets("Source").Cells(1 + i, 4)
  
    For j = 1 To NbOccurenceV2 'Boucle sur le nombre d'occurrences
      
        Worksheets("Cible").Cells(1 + Compteur1, 1) = Worksheets("Source").Cells(1 + i, 1)
        Worksheets("Cible").Cells(1 + Compteur1, 5) = Worksheets("Correspondance V1 V2").Cells(Application.WorksheetFunction.Match(Worksheets("Source").Cells(1 + i, 1), Worksheets("Correspondance V1 V2").Range("A:A"), 0) + j - 1, 2)
        Compteur1 = Compteur1 + 1
      
    Next j
  
Next i

End Sub

 

[pierrejean]

Bonjour Arnaud
Salut Nairolf

Je l'ai fait , je le poste

 

[Arnaud81]

Bonjour Pierre Jean et Nairolf,

Merci pour vos propositions.

Pierre Jean, cela fonctionne avec cependant un bemol puisque j'ai plusieurs onglets avec pas forcement toutes les fonctions.

Exemple, dans l'onglet cible 1 j'aurai la fonction A et la fonction C et dans l'onglet cible 2 la fonction B et la fonction E et dans ce cas, la macro actuelle me ramène la totalité de la liste des fonctions dans chacun des onglets.

Serait il possible en prenant exemple de l'onglet cible 1 de ramener seulement les fonctions A et C ? (une sorte de recherche v mais je n'y connais pas grand chose...)

Merci d'avance!

 

[Arnaud81]

Salut,

Essaye avec le code suivant (à noter que je n'ai rapatrié que les colonnes extrêmes car les colonnes intermédiaires sont sur le même principe que la première colonne) :

Sub V1V2()

'Définition des variables
Dim NbFonction As Integer
Dim i As Integer
Dim j As Integer
Dim NbOccurenceV2 As Integer
Dim Compteur1 As Integer
'/Définition des variables

'Initialisation
NbFonction = Application.WorksheetFunction.CountA(Worksheets("Source").Range("A:A")) - 1
Compteur1 = 1
'/Initialisation

For i = 1 To NbFonction 'Boucle sur le nombre de fonctions
 
    NbOccurenceV2 = Worksheets("Source").Cells(1 + i, 4)
 
    For j = 1 To NbOccurenceV2 'Boucle sur le nombre d'occurrences
     
        Worksheets("Cible").Cells(1 + Compteur1, 1) = Worksheets("Source").Cells(1 + i, 1)
        Worksheets("Cible").Cells(1 + Compteur1, 5) = Worksheets("Correspondance V1 V2").Cells(Application.WorksheetFunction.Match(Worksheets("Source").Cells(1 + i, 1), Worksheets("Correspondance V1 V2").Range("A:A"), 0) + j - 1, 2)
        Compteur1 = Compteur1 + 1
     
    Next j
 
Next i

End Sub

Nairolf,

Je viens de tester ta macro en l'adaptant. Par contre, comment faire si je souhaite que les modifications soient réalisées sur l'onglet source (l'onglet cible étant une image de ce que j'aimerais obtenir sur l'onglet source) ?

Merci d'avance

Arnaud

 

[Nairolf]

Salut Pierre Jean.

Arnaud,

Je suis désolé, mais je n'ai pas tout compris, quelles données sont à exploiter pour obtenir le résultat identique à l'onglet "cible" ?

 

[Arnaud81]

Dans mon fichier complet, j'ai l'onglet V1 V2 et l'onglet Source.


Dans l'exemple, j'ai ajouté l'onglet cible pour montrer le résultat que je voulais avoir sur l'onglet source une fois la macro exécutée.

Dans le code que tu m'as envoyé, j'ai donc modifié les lignes suivantes :

Sheets("Cible").Range("A2:E" & Rows.Count).ClearContents
Sheets("Cible").Range("A2").Resize(UBound(tabres, 1) + 1, UBound(tabres, 2)) = tabres

en

Sheets("Source").Range("A2:E" & Rows.Count).ClearContents
Sheets("Source").Range("A2").Resize(UBound(tabres, 1) + 1, UBound(tabres, 2)) = tabres

et cela fonctionne parfaitement sur l'exemple que j'ai envoyé.

Cependant, dans mon fichier complet, j'ai plusieurs onglets qui doivent être modifiés (je vais adapter une macro par onglet)
onglet 1 j'ai seulement la fonction A et la fonction C
onglet 2 la fonction B et la fonction E

Quand je fais tourner la macro sur chacun de ces onglet, cela me crée bien mes lignes pour les deux fonctions présentes (exemple fonction A avec 6 lignes) mais cela me colle également la totalité des autres fonctions.

J'ai fais une V2 de mon fichier excel (en pj) pour coller un peu plus à la réalité de mon fichier complet à partir de ce que tu m'avais envoyé.

Merci beaucoup pour le temps que tu me consacres!

Arnaud

 

[Arnaud81]

Dans mon fichier complet, j'ai l'onglet V1 V2 et l'onglet Source.


Dans l'exemple, j'ai ajouté l'onglet cible pour montrer le résultat que je voulais avoir sur l'onglet source une fois la macro exécutée.

Dans le code que tu m'as envoyé, j'ai donc modifié les lignes suivantes :

Sheets("Cible").Range("A2:E" & Rows.Count).ClearContents
Sheets("Cible").Range("A2").Resize(UBound(tabres, 1) + 1, UBound(tabres, 2)) = tabres

en

Sheets("Source").Range("A2:E" & Rows.Count).ClearContents
Sheets("Source").Range("A2").Resize(UBound(tabres, 1) + 1, UBound(tabres, 2)) = tabres

et cela fonctionne parfaitement sur l'exemple que j'ai envoyé.

Cependant, dans mon fichier complet, j'ai plusieurs onglets qui doivent être modifiés (je vais adapter une macro par onglet)
onglet 1 j'ai seulement la fonction A et la fonction C
onglet 2 la fonction B et la fonction E

Quand je fais tourner la macro sur chacun de ces onglet, cela me crée bien mes lignes pour les deux fonctions présentes (exemple fonction A avec 6 lignes) mais cela me colle également la totalité des autres fonctions.

J'ai fais une V2 de mon fichier excel (en pj) pour coller un peu plus à la réalité de mon fichier complet à partir de ce que tu m'avais envoyé.

Merci beaucoup pour le temps que tu me consacres!

Arnaud

Oups, je pensais que c'était Pierre Jean qui me demandait de préciser et non Nairolf

 

[Arnaud81]

Salut Pierre Jean.

Arnaud,

Je suis désolé, mais je n'ai pas tout compris, quelles données sont à exploiter pour obtenir le résultat identique à l'onglet "cible" ?

Dans mon fichier complet, je n'ai que deux onglets V1 V2 et Source. J'avais mis l'onglet cible dans l'exemple pour montrer ce que devait faire la macro et le résultat que j'attendais sur l'onglet Source.

Merci d'avance pour ta réponse

Arnaud

 

[Nairolf]

Voici un fichier un peu plus avancé, clic sur le "bouton" de l' "onglet 2".
A adapter, mais plusieurs éléments pourront te servir de base de travail.

 

[pierrejean]

Re

Vois si cela te convient

 

[Arnaud81]

Merci messieurs, cela fonctionne!!

Bonne soirée!