Supprimer caractères à gauche de cellules et comptabiliser la catégorie

Webperegrino

XLDnaute Impliqué
Supporter XLD
Bonsoir le Forum
Voici un fichier dans lequel j’explique le principe de fonctionnement en feuille 1 :
Les étapes sont décrites en partie supérieure ; le résultat attendu en partie centrale et inférieure.
Dans ma macro Sub Prénoms()
Je n’arrive pas à passer de l’étape 2 à l’étape 3 en feuille 'SYNTH'.
Par la suite je ne devrais pas avoir trop de difficultés à passer à l’étape 4 (trier et supprimer les lignes vides).

J’ai fait une approche de formule pour extraire les valeurs relatives aux 'Prénoms', tout en retirant des Identifications les 7 caractères de gauche ‘Prénom + son espace qui suit, soit 7 caractères’ .

Ma formule ne fonctionne pas avec 'NBCAR' dans
.Range("H" & lh).Value = Right("A" & x, NBCAR(I10) - 7)

Avez-vous une solution pour que cela fonctionne par macro-commande ?
Merci
Webperegrino
 

Pièces jointes

  • TESTW.xls
    51.5 KB · Affichages: 42
Dernière édition:

kjin

XLDnaute Barbatruc
Re : Supprimer 7 caractères de gauche de certaines cellules et comptabiliser la catég

Bonsoir,
Pas vraiment clair
Code:
Sub Prénoms()
Dim T$, Tablo(), d As Object
Dim i%, j%, k%, x%
Set d = CreateObject("Scripting.Dictionary")
With Feuil1
    For i = 8 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If .Cells(i, 1) Like "Prénom*" Then
            T = Split(.Cells(i, 1), " ")(1)
            If Not d.exists(T) Then
                d.Add T, T
                x = x + 1
                ReDim Preserve Tablo(1 To 2, 1 To x)
                Tablo(1, x) = T
                Tablo(2, x) = Application.SumIf(.Columns(1), "*" & T, .Columns(2))
            End If
        End If
    Next
    For i = 1 To UBound(Tablo, 2)
        j = i
        For k = j + 1 To UBound(Tablo)
            If Tablo(1, k) <= Tablo(1, j) Then j = k
        Next
        If i <> j Then
            sT1 = Tablo(1, j)
            sT2 = Tablo(2, j)
            Tablo(1, j) = Tablo(1, i)
            Tablo(2, j) = Tablo(2, i)
            Tablo(1, i) = sT1
            Tablo(2, i) = sT2
        End If
    Next
End With
With Feuil3
    .Range("A2").Resize(UBound(Tablo, 2), UBound(Tablo, 1)) = Application.Transpose(Tablo)
End With
End Sub
A+
kjin
 

Pièces jointes

  • wp.xls
    39 KB · Affichages: 34

Webperegrino

XLDnaute Impliqué
Supporter XLD
Re : Supprimer 7 caractères de gauche de certaines cellules et comptabiliser la catég

Bonjour Le Forum,
Bonjour Kjin,
Il est vrai que mes explications étaient confuses, mais tu as très bien corrigé la macro.
La rectification est d'ailleurs plus professionnellle.
Je l'adopte comme dans le fichier ci-joint, avec en plus un choix d'identifiant avant de lancer la macro.
Merci, c'est parfait.
Cordialement
Webperegrino
 

Pièces jointes

  • TESTW2.xls
    64 KB · Affichages: 46

Webperegrino

XLDnaute Impliqué
Supporter XLD
Re : Supprimer caractères à gauche de cellules et comptabiliser la catégorie

Le Forum,
Kjin,
Je reviens une dernière fois vers toi car j’ai un dernier souci.

Dans l’adaptation de ta macro dans ma réelle application, trop conséquente en Mo pour être placée ici, je découvre ta fonction Tablo et Split que ne comprends pas encore très bien (T = Split(.Cells(i, 1), " ")(1))

Comment transposer ta macro si la zone source est sur la Feuil15(SYNTH)
Avec les identifiants de C2 :C…
Avec les valeurs de D2 :D
Tout en gardant la destination du résultat en Feuil15(SYNTH) à partir des cellules H26 et I26 ?

En essayant d’adapter j’ai un message d’erreur :
Erreur d’exécution 9, sur la ligne : For i = 1 To UBound(Tablo, 2)

Voici comment j’ai essayé d’adapter ta macro dans le fichier :

VB:
Sub Calc()
Dim T$, Tablo(), d As Object
Dim n%, id, i%, j%, k%, x%, lh%, lf%
Set d = CreateObject("Scripting.Dictionary")
n% = Cells(Rows.Count, 9).End(xlUp).Row
Range("H26:I" & n%).Select 'nettoie la zone de réception des calculs
VID
id = Sheets(15).Range("H23").Value 'détermine le type d'identifiant à centraliser

With Feuil15 'calcul de Kjin 19janv13 [url]www.excel-downloads.com/forum/199532[/url]
    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
        'If .Cells(i, 1) Like "Prénom*" Then
        If .Cells(i, 3) Like id Then
            T = Split(.Cells(i, 3), " ")(1)
            If Not d.exists(T) Then
                d.Add T, T
                x = x + 1
                ReDim Preserve Tablo(1 To 2, 1 To x)
                Tablo(1, x) = T
                Tablo(2, x) = Application.SumIf(.Columns(1), "*" & T, .Columns(2))
            End If
        End If
    Next
    For i = 1 To UBound(Tablo, 2)
        j = i
        For k = j + 1 To UBound(Tablo)
            If Tablo(1, k) <= Tablo(1, j) Then j = k
        Next
        If i <> j Then
            sT1 = Tablo(1, j)
            sT2 = Tablo(2, j)
            Tablo(1, j) = Tablo(1, i)
            Tablo(2, j) = Tablo(2, i)
            Tablo(1, i) = sT1
            Tablo(2, i) = sT2
        End If
    Next
End With
With Feuil15
    .Range("H26").Resize(UBound(Tablo, 2), UBound(Tablo, 1)) = Application.Transpose(Tablo)
lh = .Cells(Rows.Count, 8).End(xlUp).Row
    Range("H26:I" & lh).Select 'ordonner
    Selection.Sort Key1:=Range("H26"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

lf = lh + 2
.Range("H" & lf).Value = "TOTAL :"
.Range("I" & lf).Value = "=SUM(I26:I" & lh & ")"
.Range("I26:I" & lf).NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
.Range("I26:I" & lf).Font.Bold = True
Range("H26:I" & lh).Select 'cadrer
cadre
'Range("H" & lf & ":I" & lf).Select
'cadre
Range("H23").Select
End With
End Sub
 

kjin

XLDnaute Barbatruc
Re : Supprimer caractères à gauche de cellules et comptabiliser la catégorie

Bonsoir,
C'est un peu compliqué sans fichier....
Mais attention sheets(15) et Feuil15, c'est pas la même chose...
Donc je veux bien t'aider, mais fourni au moins la structure du classeur avec qq données bidons

A+
kjin
 

Webperegrino

XLDnaute Impliqué
Supporter XLD
Re : Supprimer caractères à gauche de cellules et comptabiliser la catégorie

Bonjour Le Forum,
Bonjour Kjin,
Je te remercie Kjin d'accepter de continuer à m'aider dans la compréhension de ta macro.
Dès que je peux je te joins un fichier clair avec ce que j'attends du résultat d'extraction avec ta macrocommande (j'ajoute
un déroulant pour choisir la recherche).
Webperegrino
 

Webperegrino

XLDnaute Impliqué
Supporter XLD
Re : Supprimer caractères à gauche de cellules et comptabiliser la catégorie

Le Forum,
Kjin,
Bonsoir,
Le fichier ci-joint a été simplifié, et fait fi des autres macros pour placement ordonné du résultat dans la feuille Feuil15(SYNTH), en colonnes C et D, à partir de la ligne 2.

Ce fichier exemple reprend maintenant la structure « feuille-colonnes-lignes » semblable à mon fichier réel et ne donne donc que l'essentiel pour le bon fonctionnement de ta macro que j’ai référencée Sub Kjin ()

Si on choisit (cellule J24) par exemple BOUTIQUE* :
à partir de la ligne 26, nous aurons en liste en colonne H et I l’extraction ordonnée des cellules BOUTIQUE avec leur total correspondant. C’est ce que ta macro fait déjà.

L’avantage de ta macro c’est qu’on n’est pas obligé d’être figé avec seulement 8 lettres et son blanc qui suit (par exemple Boutique + espace).
Kjin , ta solution :
id = Sheets(3).Range("J24").Value
qui détermine le type d'identifiant à centraliser est géniale ! J’apprécie.

Je voudrais aussi réussir une extraction en H et I 26 et suivantes ave,c par exemple seulement les BOUTIQUE MAIL (BOUTIQUE + 1er espace + MAIL + 2ème espace).

En effet, dans mon fichier original, le souci est que je peux avoir à sélectionner une gauche de texte avec deux espaces (placée dans le déroulant toutefois) :
- soit SARL + espace + FLEXITA
- soit SARL + espace + ETS + espace + TARDIEUX
- etc

avec dans le déroulant cellule J24 :
SARL* ; SARL ETS*

Pour gérer les deux sortes d’extractions, mettre « SARL_ETS + espace » ne semble pas résoudre l’affaire pour éliminer le début de mes identifiants dans le résulta en H26 et suivantes.
Voir aussi encadré couleur saumon dans le fichier. J'ai constaté aussi que tous les éléments du déroulant ne donne pas leur résultat attendu.

Enfin, si ce n’est pas trop demandé, j’aimerais que tu m’expliques comment ta macro excellente fonctionne, pas à pas.
Je veux apprendre – l’objectif de ma présence sur ce Forum - et ne pas seulement exploiter ta trouvaille.
Ainsi et ensuite, il me sera alors tellement plaisant de pouvoir aider à mon tour d’autres personnes en demande.
Bien cordialement
Webperegrino
 

Pièces jointes

  • TESTKjin1.xls
    60 KB · Affichages: 31

Webperegrino

XLDnaute Impliqué
Supporter XLD
Re : Supprimer caractères à gauche de cellules et comptabiliser la catégorie

Bonjour Le Forum,
De longues heures de recherches pour trouver une adaptation du fichier de Kjin.
La macro fait maintenant les calculs sur colonne C et colonne B.

Elle arrive à ôter le premier mot (BAR, Boutique, etc) pour classer et comptabiliser les sous-totaux demandés par le choix en cellule K22.

Le problème c'est que, si on laisse d'autres espaces que le premier (entre BARNARD et Damien par exemple) cette cellule n’aura pas sa valeur comptabilisée. Mes groupes de mots peuvent contenir plus d’un espace.

Pour faire fonctionner cette macro, j’ai appliqué une solution en place dans le fichier ci-joint, mais elle me dérange :
Les espaces n° 2, n° 3, n° 4, etc passent en _ (exemple : BAR BARNARD_damien_Synth)

Question :
Comme plusieurs personnes feront les saisies, comment faire fonctionner la macro en n'ayant que des espaces entre les mots ?

Merci pour votre aide,

Webperegrino
 

Pièces jointes

  • TESTW2(vend25janv_2).xls
    67.5 KB · Affichages: 36

Discussions similaires

Statistiques des forums

Discussions
312 775
Messages
2 092 021
Membres
105 150
dernier inscrit
maxissof