Excel et les chaînes de caractères

[jeanphi]

Bonsoir

Dans le classeur ci joint je souhaite développer une macro me permettant de regrouper les cellules A20 et A21 sous un seul et même nom qui serait "CASTRES CHARTREUSE" et donc de cumuler le montant de B20 et B21 et de D20 et de D21 et donc de calculer les nouveaux pourcentages des colonnes C et E
Quelqu'un sait t'il faire cela?
Merci

 

[Staple1600]

Re : Excel et les chaînes de caractères

Bonsoir


Une possibilité

 

[job75]

Re : Excel et les chaînes de caractères

Bonsoir jeanphi, Staple,

Perso j'ai compris qu'il faut faire des regroupements, et la macro est pratiquement terminée.

Mais je bute sur les pourcentages : que signifient-ils ? Que faut-il en faire dans les regroupements ?

Merci de préciser.

Edit : bon, je pense calculer pour chaque pourcentage la valeur à 100% puis me débrouiller ensuite...

A+

 

[job75]

Re : Excel et les chaînes de caractères

Re,

Voici donc le fichier et la macro :

Private Sub CommandButton1_Click()
Dim i As Long, pc1 As Double, pc2 As Double
With Sheets("Regrouper")
  Cells.Copy .Cells
  '---suppression des chiffres en fin de texte et autres fioritures---
  For i = 3 To .Range("A5536").End(xlUp).Row
1   If IsNumeric(Right(RTrim(.Cells(i, 1)), 1)) Then .Cells(i, 1) = Left(.Cells(i, 1), Len(.Cells(i, 1)) - 1): GoTo 1
    .Cells(i, 1) = Application.Trim(Replace(.Cells(i, 1), "-", " ")) 'suppression des tirets et espaces superflus
  Next
  .Range("A2:E65536").Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes 'tri
  '---suppression des doublons avec addition des volumes et pourcentages---
  On Error Resume Next
  For i = .Range("A5536").End(xlUp).Row To 4 Step -1
    If .Cells(i, 1) = .Cells(i, 1).Offset(-1) Then
      pc1 = 0: pc2 = 0
      pc1 = (.Cells(i, 2) + .Cells(i, 2).Offset(-1)) / (.Cells(i, 2) / .Cells(i, 3) + .Cells(i, 2).Offset(-1) / .Cells(i, 3).Offset(-1))
      pc2 = (.Cells(i, 4) + .Cells(i, 4).Offset(-1)) / (.Cells(i, 4) / .Cells(i, 5) + .Cells(i, 4).Offset(-1) / .Cells(i, 5).Offset(-1))
      .Cells(i, 2).Offset(-1) = .Cells(i, 2) + .Cells(i, 2).Offset(-1)
      .Cells(i, 4).Offset(-1) = .Cells(i, 4) + .Cells(i, 4).Offset(-1)
      .Cells(i, 3).Offset(-1) = IIf(pc1, pc1, "")
      .Cells(i, 5).Offset(-1) = IIf(pc2, pc2, "")
      .Rows(i).Delete
    End If
  Next
  .Activate
End With
End Sub

Par sécurité, tout se fait dans la feuille "Regrouper".

Edit : j'ai ajouté un petit On Error Resume Next car il y a des cellules vides par ci par là...

A+

 

[job75]

Re : Excel et les chaînes de caractères

Bonjour jeanphi, le fil, le forum,

La macro précédente traitait seulement 2 mois, voici pour un nombre de mois quelconque :

Private Sub CommandButton1_Click()
Dim i As Long, n As Byte, j As Byte, v As Double, pc As Double
With Sheets("Regrouper")
  Cells.Copy .Cells
  '---suppression des chiffres en fin de texte et autres fioritures---
  For i = 3 To .Range("A5536").End(xlUp).Row
1   If IsNumeric(Right(RTrim(.Cells(i, 1)), 1)) Then .Cells(i, 1) = Left(.Cells(i, 1), Len(.Cells(i, 1)) - 1): GoTo 1
    .Cells(i, 1) = UCase(Application.Trim(Replace(.Cells(i, 1), "-", " "))) 'suppression des tirets et espaces superflus, mise en majuscules
  Next
  .Range("A3:[COLOR="Red"]IV[/COLOR]65536").Sort Key1:=.Range("A3"), Order1:=xlAscending, Header:=xlNo 'tri
  '---suppression des doublons avec addition des volumes et pourcentages---
  On Error Resume Next
  [COLOR="Red"]n = Application.CountA(.Rows(1)) 'nombre de mois à traiter[/COLOR]
  For i = .Range("A5536").End(xlUp).Row To 4 Step -1
    If .Cells(i, 1) = .Cells(i, 1).Offset(-1) Then
      [COLOR="Red"]For j = 2 To 2 * n Step 2
        v = .Cells(i, j) + .Cells(i - 1, j)
        pc = 0 'en cas d'erreur ligne suivante
        pc = v / (.Cells(i, j) / .Cells(i, j + 1) + .Cells(i - 1, j) / .Cells(i - 1, j + 1))
        .Cells(i - 1, j) = v
        .Cells(i - 1, j + 1) = IIf(pc, pc, "")
      Next[/COLOR]
      .Rows(i).Delete
    End If
  Next
  .Activate
End With
End Sub

Edit : ajouté aussi une mise en majuscules (cf Cahors)...

A+

 

[jeanphi]

Re : Excel et les chaînes de caractères

Bonjour STAPLE et merci pour ton aide!! 🙂

 

[jeanphi]

Re : Excel et les chaînes de caractères

bonjour job75 et merci à toi pour ce beau code que je vais tester dès que possible!!
bonne journée 🙂