XL 2013 somme activecell

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

  • GENEBOX.v3.xlsm
    126.5 KB · Affichages: 21
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
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
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
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
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
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

Discussions similaires

P
  • Question
XL 2016 Recherche et somme de plusieurs critères
Réponses
2
Affichages
372
JHA
J
F
  • Question
XL 2016 Faire une somme en fonction de 2 critères + 1 critère si contient un texte
Réponses
2
Affichages
486
flo189
F
S
  • Question
Microsoft 365 Utilisation de SOMME.SI.ENS avec critères potentiellement à ne pas prendre en compte
Réponses
1
Affichages
532
job75
job75
G
  • Question
Microsoft 365 Avoir des classeurs maitres et les procédures dans un autre classeur.
2
Réponses
18
Affichages
1 K
GClaire
G
R
  • Résolu(e)
XL 2013 somme a partir d'une sélection
Réponses
2
Affichages
568
RomainPOIRET
R
D
  • Résolu(e)
Microsoft 365 Graphique avec plage de données glissante en partant d'une date
Réponses
5
Affichages
236
Dégé59
D
T
  • Résolu(e)
XL 2016 [VBA] Référence en double, additionner les quantités
Réponses
11
Affichages
631
terry08200
T
M
  • Résolu(e)
XL 2021 calcul : Somme des quantités de chaque produit à fabriquer
Réponses
3
Affichages
748
MinstrelL
M
petitbuzuc
  • Question
XL 2016 (résolu) fusionner 2 lignes
Réponses
5
Affichages
392
petitbuzuc
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
1 K
arno1234
A

Membres actuellement en ligne

14 membres et 103 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 093
Messages
2 116 138
Membres
112 669
dernier inscrit
Guigui2502