VBA sous total (somme ; plage de donnée)

LeChapelain100 -  
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour
Pour automatiser la réalisation de devis, j’ai commencé à réaliser un programme VBA qui va chercher des informations (Désignation, unité, quantité, prix unitaire) dans un autre onglet. Cependant dans la colonne montant je souhaiterais que le code fasse soit un produit soit un sous-total en fonction de la hiérarchie de la désignation (titre, sous-titre ou article). J’arrive à faire le produit pour les articles, mais je n’arrive par à faire le sous-total des titres et des sous-titre en lui indiquant au code où il doit s’arrêter pour la sélection de la plage de données

Configuration: Windows / Chrome 94.0.4606.71

8 réponses

  1.
    yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonjour,
    montre-nous ton code, ce sera peut-être plus concret.
    si ce n'est pas évident dans le code, dis-nous en plus à propos de la hiérarchie de la désignation.
    0
  2. LeChapelain100 Messages postés 7 Statut Membre
     
    0
  3. LeChapelain100 Messages postés 7 Statut Membre
     
    0
  4. LeChapelain100 Messages postés 7 Statut Membre
     
    Voici mon code avec la partie en jaune qui bug et un tableau explicatif de ce que je souhaite réaliser
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. LeChapelain100 Messages postés 7 Statut Membre
     
    Sub copier_coller_celluleProgap_DPGS2()
    
    'nommination les valiables pour le nom du fichier et des onglets.
Dim wk_fichier As Workbook
Dim ws_BASE As Worksheet
Dim ws_GO As Worksheet
Dim lstrw_BASE As Long, lstrw_GO As Long 'création de 2 variables signifiant dernière ligne (last row)de la feuille BASE et feuille GO qui est un nombre entier (long)

    'définition des valiables pour le nom du fichier et des onglets.
Set wk_fichier = ActiveWorkbook
Set ws_BASE = wk_fichier.Worksheets(1) 'je raccroche l'onglet feuil1 avec ce fichier. Le 1 dans les () correspond à la position de l'onglet.
Set ws_GO = wk_fichier.Worksheets(5)

     
    'identifier la dernière ligne colonne A  de la feuille BASE, ma variable lstrw = à la celule ...
lstrw_BASE = ws_BASE.Cells(Rows.Count, 1).End(xlUp).Row
    
    'commencer la boucle à la ligne 19 car avant c'est du bla bla
For i = 19 To lstrw_BASE
    
    'identifier le type (C1 S1 L1...) et si = à S1, copier coller à l'onglet GO, si la valeur de la feuille Base et de la cellule qui se trouve en ligne i et colone A
    If ws_BASE.Cells(i, 1) = "S1" Then
    
    'identifier la dernière ligne colonne A  de la feuille GO, ma variable lstrw = à la celule ...
    'End(xlUp) pour dire que je remonte pour voir la dernière ligne complétée et .row car je cherche des lignes
    lstrw_GO = ws_GO.Cells(Rows.Count, 1).End(xlUp).Row
          
    'copier coller de la cellule
    ws_GO.Cells(i, 1) = ws_BASE.Cells(i, 13) 'la cellule A1 (1,1) de la feuiller GO = à la celule A1 de la feuille BASE
    
    End If
Next

For i = 19 To lstrw_BASE
    
    'identifier le type (C1 S1 L1...) et si = à P1, copier coller à l'onglet GO, si la valeur de la feuille Base et de la cellule qui se trouve en ligne i et colone A
    If ws_BASE.Cells(i, 1) = "P1" Then
    
    'identifier la dernière ligne colonne A  de la feuille GO, ma variable lstrw = à la celule ...
    'End(xlUp) pour dire que je remonte pour voir la dernière ligne complétée et .row car je cherche des lignes
    lstrw_GO = ws_GO.Cells(Rows.Count, 1).End(xlUp).Row
       
    'copier coller de la cellule
    ws_GO.Cells(i, 2) = ws_BASE.Cells(i, 13) 'la cellule A1 (1,1) de la feuiller GO = à la celule A1 de la feuille BASE
² ws_GO.Cells(i, 8) = "=SUBTOTAL(9,R[1]C:R[j]C)"
    j = "=COUNTIF(R[1]C[-4]:R[2]C[-5],"""")"
    End If
Next

For i = 19 To lstrw_BASE
    
    'identifier le type (C1 S1 L1...) et si = à L1, copier coller à l'onglet GO, si la valeur de la feuille Base et de la cellule qui se trouve en ligne i et colone A
    If ws_BASE.Cells(i, 1) = "L1" Then
    
    'identifier la dernière ligne colonne A  de la feuille GO, ma variable lstrw = à la celule ...
    'End(xlUp) pour dire que je remonte pour voir la dernière ligne complétée et .row car je cherche des lignes
    lstrw_GO = ws_GO.Cells(Rows.Count, 1).End(xlUp).Row
      
    'copier coller de la cellule
    ws_GO.Cells(i, 3) = ws_BASE.Cells(i, 13) 'la cellule A1 (1,1) de la feuiller GO = à la celule A1 de la feuille BASE
    ws_GO.Cells(i, 8) = "=PRODUCT(RC[-2]:RC[-1])"
    ws_GO.Cells(i, 14) = ws_BASE.Cells(i, 6)
    ws_GO.Cells(i, 16) = ws_BASE.Cells(i, 8)
    End If
Next

For i = 19 To lstrw_BASE
         
    'copier coller de la cellule unité
    ws_GO.Cells(i, 5) = ws_BASE.Cells(i, 5) 'la cellule A1 (1,1) de la feuiller 2 = à la celule A1 de la feuille 1
    
Next


End Sub
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      Je ne comprends pas bien comment l'onglet BASE est organisé, et à quoi correspondent les types, qui semblent être tous copiés dans l'ordre de leur type.
      0
  7. LeChapelain100 Messages postés 7 Statut Membre
     
    Bonjour voici comment est organisé mon onglet base, c'est une extraction de données.
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      Je ne comprends pas comment le code parvient à créer l'autre onglet à partir de l'onglet base. Crée-t-il réellement l'onglet tel que tu le montres en #2?
      0
  8. LeChapelain100 Messages postés 7 Statut Membre
     
    Non l'onglet GO est déjà créé dans mon Excel. C’est un onglet avec un gabarit standard que l'on utilise pour nos devis. Je viens juste récupérer les donner de l'onglet BASE pour les coller dans l'onglet GO sauf que pour le montant je dois rentrer des formules différentes en fonction du titre ou de l'article. C'est pourquoi je voulais optimiser cette manipulation.
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      Cela devient de moins en moins clair.
      Si le gabarit est standard, pourquoi ne pas utiliser des formules fixes, pourquoi utiliser du VBA pour créer ces formules?
      0
  9. LeChapelain100 Messages postés 7 Statut Membre
     
    Voici l'onglet GO, les formules sont réécrites pour chaque chiffrage de projet, car le nombre d'articles dans chaque sous-titre varie en fonction du projet
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      L'onglet BASE serait-il alors spécifique à chaque projet?

      L'image en #2 est-elle cohérente avec l'image en #8?

      Le code existant transfère, ligne par ligne, les données de BASE vers GO. Il fait cela d'abord pour les tous les titres, puis pour les tous les sous-titres, puis pour tous les articles.

      Si je comprends bien le contexte et l'objectif, je suggère d'exécuter ceci après avoir excécuté le code existant: 
      Option Explicit

Private Sub st()
Const cg As Long = 7
Dim wbase As Worksheet, wgo As Worksheet
Dim ligs As Long, ligp As Long
Dim curl As Long
Dim forms As String
Set wbase = ThisWorkbook.Sheets("base")
Set wgo = ThisWorkbook.Sheets("go")
curl = 19
ligs = 0
ligp = 0
Do While True
    wgo.Cells(curl, 1) = wbase.Cells(curl, 1)
    Select Case wbase.Cells(curl, 1)
        Case "S1":
            If ligs > 0 Then
                wgo.Cells(ligs, cg).FormulaLocal = forms
            End If
            forms = ""
            ligs = curl
            If ligp > 0 Then
                wgo.Cells(ligp, cg).FormulaLocal = "=sum(g" + CStr(ligp + 1) + ":g" + CStr(curl - 1) + ")"
            End If
            ligp = 0
        Case "P1":
            If ligp > 0 Then
                wgo.Cells(ligp, cg).FormulaLocal = "=sum(g" + CStr(ligp + 1) + ":g" + CStr(curl - 1) + ")"
            End If
            ligp = curl
            If forms = "" Then
                forms = "=g" + CStr(curl)
            Else
                forms = forms + "+g" + CStr(curl)
            End If
        Case "":
            If ligp > 0 Then
                wgo.Cells(ligp, cg).FormulaLocal = "=sum(g" + CStr(ligp + 1) + ":g" + CStr(curl - 1) + ")"
            End If
            If ligs > 0 Then
                wgo.Cells(ligs, cg).FormulaLocal = forms
            End If
            Exit Do
    End Select
    curl = curl + 1
Loop
End Sub


      EDIT: code corrigé
      0

Discussions similaires

Retrouver l'image originale d'une photo modifiée
Raven -
Asta972155 -

10 réponses
Désactiver renouvellement automatique anti virus Total AV
Syldra -
Val -

11 réponses
Site fiable ou arnaque ?
mamanvan -
wynants -

10 réponses
Calcul des ventes par mois d'un produit
buck.danny -
elena -

7 réponses
Dechiffrer une image caché
JACQUE -
Otomec -

1 réponse