Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 somme activecell

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
R

RomainPOIRET

XLDnaute Occasionnel
Bonjour à tous,

Je souhaite savoir comment additionner des activecells, je m'explique,

J'ai un fichier macro, la macro consiste à fusionner des cellules à l'aide d'un clic droit. Cette fusion renseigne une référence (ex : "A") et une quantité (ex : 3), j'ai un msgbox qui m'indique la référence & la quantité soit "A3";

Lorsque je prend une plage à fusionner + "ctrl" + une autre plage a fusionner, je souhaite que la macro me fasse la somme des quantités soit A3 + A3 soit msg box "A6".
Aujourd'hui quand je le fais j'ai dans me msgbox "A3" ...

Voyez-vous ce que je veux dire ?

Je vous place ci-joint mon fichier, aller directement dans l'onglet "REMPLISSAGE",

Cordialement,

Romain
 

Pièces jointes

Trier par date Trier par votes
Bonsoir Romain, bonsoir le forum,

Je n'ai pas ouvert ton fichier car je n'ai pas bien compris ton énoncé mais...
VBA et les cellules fusionnées ne sont pas de bons amis...
Il n'y a qu'une seule cellule active même si la plage contient plusieurs cellules. Tu ne pourras pas additionner les "Activecell" mais boucler sur plusieurs cellules d'une plage. Par exemple Tu sélectionnes 3 cellules contenant des entiers :
VB: 
Dim CEL as Range
Dim T As Integer
For each CEL in Selection
    T = T + CEL.Value
Next CEL
MsgBox T
 
Vote positif 0 Vote négatif
Bonjour Romain, Robert, le forum

pas sur d'avoir bien compris mais cette modif te conviendra peut être.

Bien cordialement
VB: 
Private Sub nb_ref_Change()

Application.ScreenUpdating = False

'déclaration de la variable "résultat"
Dim resultat, danger As Variant
danger = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A2:G27"), 5, False)
resultat = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A2:G27"), 7, False)

'Si la référence est caractérisée comme dangereuse, un message apparait sur le userform4
If danger = "OUI" Then
    dangereux.Visible = True
Else
    dangereux.Visible = False
End If

'si la référence est renseignée, afficher le nombre d'UCs restants
If Me.nb_ref.Value <> "" Then
    part1.Visible = True
    part2.Visible = True
    Me.uc_restant.Caption = resultat
    options.Visible = False
    If resultat <= 0 Then
        uc.Enabled = False
        nb_uc.Enabled = False
        part1.Enabled = False
        uc_restant.Enabled = False
        part2.Enabled = False
    ElseIf resultat > 0 Then
        uc.Enabled = True
        nb_uc.Enabled = True
        part1.Enabled = True
        uc_restant.Enabled = True
        part2.Enabled = True
    End If
   
End If

Me.uc_restant.Caption = WorksheetFunction.VLookup(Me.nb_ref.Value, [tableau_ref], 7, False) 'Modif


Application.ScreenUpdating = True

End Sub
 
Vote positif 0 Vote négatif
tu peux aussi alléger ton code avec des with/end with
et je ne sais pas pourquoi tu utilises des End pour stopper le code alors qu'un Exit sub devrait mieux convenir
VB: 
Private Sub ok_bouton_Click()

Application.ScreenUpdating = False

'Déclaration de 2 variables
Dim i As Long
Dim couleur, ean As Variant

couleur = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A1:G27"), 6, False)
ean = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A1:G27"), 3, False)

With Selection
    If nb_ref.Value <> "" Then
        If CSng(uc_restant.Caption) < CSng(nb_uc.Value) Then
            MsgBox "Vous n'avez pas la capacité de mettre tant d'UC / lots !", vbInformation, "Information"
            End
        End If
       
        For i = 2 To 27
            If Sheets("TEMPLATE_FAC").Range("A" & i).Value = nb_ref.Value Then
                Sheets("TEMPLATE_FAC").Range("G" & i).Value = Sheets("TEMPLATE_FAC").Range("G" & i).Value - nb_uc.Value
            End If
        Next i
       
        .Merge
        .Interior.ColorIndex = couleur
        .Value = nb_ref & " " & nb_uc & " " & ean
       
       
    '----------- CODE A VOIR -----------------
    Dim chiffre As Integer
    Dim lettre As String
   
    chiffre = Mid(ActiveCell.Value, 3, 2)
    lettre = Mid(ActiveCell.Value, 1, 1)
   
    MsgBox lettre & " " & chiffre
        End
    End If
    '-----------------------------------------
   
    If confinement.Value = True Then
        With .Borders
            .Weight = xlMedium
            .ColorIndex = 3
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End If
   
    If calagepapier.Value = True Then
        If Me.couleur.Value = "VERTE" Then 'Mise en forme cale verte
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 4
        ElseIf Me.couleur.Value = "BLEUE" Then 'Mise en forme cale bleue
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 33
        ElseIf Me.couleur.Value = "ROUGE" Then 'Mise en forme cale rouge
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 3
        ElseIf Me.couleur.Value = "JAUNE" Then 'Mise en forme cale jaune
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 27
        ElseIf Me.couleur.Value = "BLANCHE" Then 'Mise en forme cale blanche
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 2
        End If
    End If
   
    If calagecaisse.Value = True Then
        .Merge
        .Interior.ColorIndex = 16
        .Value = quoi_caisse & " " & "(x" & qté_caisse & ")"
        .Font.ColorIndex = 1
    End If
End With


End

Application.ScreenUpdating = True

End Sub
 
Vote positif 0 Vote négatif
Yeahou à dit:
je ne sais pas pourquoi tu utilises des End pour stopper le code
Cliquez pour agrandir...

je crois que j'ai compris, plutôt brutal pour fermer le userform

VB: 
Private Sub ok_bouton_Click()

Application.ScreenUpdating = False

'Déclaration de 2 variables
Dim i As Long
Dim couleur, ean As Variant

couleur = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A1:G27"), 6, False)
ean = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A1:G27"), 3, False)

With Selection
    If nb_ref.Value <> "" Then
        If CSng(uc_restant.Caption) < CSng(nb_uc.Value) Then
            MsgBox "Vous n'avez pas la capacité de mettre tant d'UC / lots !", vbInformation, "Information"
            GoTo Sortie
        End If
        
        For i = 2 To 27
            If Sheets("TEMPLATE_FAC").Range("A" & i).Value = nb_ref.Value Then
                Sheets("TEMPLATE_FAC").Range("G" & i).Value = Sheets("TEMPLATE_FAC").Range("G" & i).Value - nb_uc.Value
            End If
        Next i
        
        .Merge
        .Interior.ColorIndex = couleur
        .Value = nb_ref & " " & nb_uc & " " & ean
        
        
    '----------- CODE A VOIR -----------------
    Dim chiffre As Integer
    Dim lettre As String
    
    chiffre = Mid(ActiveCell.Value, 3, 2)
    lettre = Mid(ActiveCell.Value, 1, 1)
    
    MsgBox lettre & " " & chiffre
        GoTo Sortie
    End If
    '-----------------------------------------
    
    If confinement.Value = True Then
        With .Borders
            .Weight = xlMedium
            .ColorIndex = 3
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End If
    
    If calagepapier.Value = True Then
        If Me.couleur.Value = "VERTE" Then 'Mise en forme cale verte
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 4
        ElseIf Me.couleur.Value = "BLEUE" Then 'Mise en forme cale bleue
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 33
        ElseIf Me.couleur.Value = "ROUGE" Then 'Mise en forme cale rouge
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 3
        ElseIf Me.couleur.Value = "JAUNE" Then 'Mise en forme cale jaune
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 27
        ElseIf Me.couleur.Value = "BLANCHE" Then 'Mise en forme cale blanche
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 2
        End If
    End If
    
    If calagecaisse.Value = True Then
        .Merge
        .Interior.ColorIndex = 16
        .Value = quoi_caisse & " " & "(x" & qté_caisse & ")"
        .Font.ColorIndex = 1
    End If
End With

Sortie:
Unload Me

Application.ScreenUpdating = True

End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

P
  • Question Question
XL 2016 Recherche et somme de plusieurs critères
Réponses
2
Affichages
506
JHA
J
P
  • Question Question
XL 2016 Macro VBA remplissage tableau de synthèse % déchet ligne de production
Réponses
4
Affichages
297
vgendron
  • Question Question
XL 2016 (résolu) fusionner 2 lignes
Réponses
5
Affichages
466
petitbuzuc
A
  • Résolu(e)
XL 2010 VBA Reporter et sommer des valeurs en fonction d'une référence et d'un n° de semaine
2
Réponses
20
Affichages
2 K
arno1234
A
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
668
arnoldbrice19
A
Z
  • Question Question
XL 2021 VBA Prélèvement d'une donnée si une valeur recherchée est identique
Réponses
3
Affichages
573
ZiM
Z
L
  • Question Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
583
AtTheOne
S
  • Résolu(e)
XL 2013 tirer une formule avec saut de plage de lignes
Réponses
10
Affichages
4 K
sergio545
S
R
  • Résolu(e)
Microsoft 365 Somme de nombres associés à des noms présents dans une liste de référence
Réponses
2
Affichages
746
Ratian
R
N
  • Résolu(e)
XL 2016 Somme valeurs cellules colorées macro
2
Réponses
17
Affichages
2 K
NIKITACAM
N
R
  • Question Question
XL 2013 Récupération données cellule fusionnée
Réponses
3
Affichages
1 K
JHA
J
T
  • Résolu(e)
Microsoft 365 Fichier Excel trop lourd (transformer mes formules en macro?)
Réponses
5
Affichages
1 K
Thomexcel
T
E
  • Résolu(e)
Microsoft 365 VBA pour faire une boucle
Réponses
5
Affichages
851
Emile63
E
  • Question Question
XL 2019 envoyer un onglet par email en format pdf
Réponses
4
Affichages
1 K
gothc
Z
  • Question Question
XL 2019 Inventaire stock en fonction d'une référence
Réponses
7
Affichages
3 K
JM27
J
D
  • Question Question
XL 2019 Besoin d'aide sur diverses macros
2 3
Réponses
31
Affichages
4 K
darknigthmare
D
J
  • Question Question
XL 2016 Lancement macro sur cellules fusionnées
Réponses
2
Affichages
1 K
joel31
J
Y
  • Question Question
XL 2016 Aide sur macro de date par rapport a une date de reference
Réponses
11
Affichages
2 K
yves03
Y
M
  • Question Question
XL 2013 Somme par semaine
Réponses
5
Affichages
4 K
Mercenr
M
S
  • Question Question
Microsoft 365 Fermeture Userform + Transpo information
Réponses
0
Affichages
573
Sonia2020
S
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…