Somme de plage sous deux conditions en VBA

Bonjour le forum,

Bonjour à tous,

Je cherche un code vba pour remplir le tableau joint. Un code pour une seule colonne avec quelques commentaires devrait suffire pour me permettre de compléter le tableau puisque c'est le même principe.

Exemple : en D18 = somme colonne H de la feuille "Stocks" à condition :

1/ que la référence en C18 de la feuille "Recap" soit égal à la première ou aux trois premières lettres du code en colonne E de la feuille "Stocks" et que

2/ les lettres en cellule D17 de la feuille "Recap" soient égales aux trois premières lettres de la colonne B de la feuille "Stocks".

MERCI.

Moutchec.

Probablement pas le plus court, mais ça fonctionne.

Pour les totaux de lignes et de colonnes, de simples formules Excel suffiront.

Sub forumexcel()

'Remettre le tableau à zéro
    Range("D18:K27").Select
    Selection.ClearContents

'Commencer à la cellule B4
   Worksheets("Stocks").Select
    Range("B4").Select

'Une boucle qui tourne tant qu'on ne tombe pas sur une cellule vide
While IsEmpty(ActiveCell.Value) = False

' Créer une variable Site avec les 3 premières lettres de colonne E
Site = Left(ActiveCell.Offset(0, 3), 3)

' Créer une variable Code avec les 3 premières lettres de la colonne B
Code = Left(ActiveCell, 3)

'Attribuer chaque Site à un numéro de ligne
If Left(Site, 1) = "S" Then
NumLigne = 18
ElseIf Site = "ECR" Then
NumLigne = 19
ElseIf Site = "ECM" Then
NumLigne = 20
ElseIf Site = "EC1" Then
NumLigne = 21
ElseIf Site = "EC2" Then
NumLigne = 22
ElseIf Site = "EP1" Then
NumLigne = 23
ElseIf Site = "EP2" Then
NumLigne = 24
ElseIf Site = "EP3" Then
NumLigne = 25
ElseIf Site = "EP4" Then
NumLigne = 26
Else
NumLigne = 27
End If

' Pareil avec les Codes en numéros de colonnes

If Code = "CH0" Then
NumCol = 4
ElseIf Code = "CH2" Then
NumCol = 6
ElseIf Code = "BBC" Then
NumCol = 8
Else
NumCol = 10
End If

' Augmenter de 1 la valeur de la bonne case du tableau Récap
   Worksheets("Recap").Cells(NumLigne, NumCol).Value = Worksheets("Recap").Cells(NumLigne, NumCol).Value + 1

'Passer à la ligne suivante
ActiveCell.Offset(1, 0).Select

Wend

End Sub

bonjour et merci.

le code bug sur cette ligne :

Range("B4").Select

encore merci.

Moutchec.

Bonjour,

il faut au moins que vba sache où commencer surtout que le code commence par un effacement de cellules !!!

Sheets("recap").Range("D18:K27").ClearContents  ' [b][color=#FF0000]ici lui dire feuille RECAP [/color][/b]
'Commencer à la cellule B4
Worksheets("Stocks").Select
[B4].Select

P.

Bonjour à tous

Un autre essai à tester.

Bye !

bonjour,

je viens de modifier ainsi :

Sheets("recap").Range("D18:K27").ClearContents

Worksheets("Stocks").Range("B4").Select

pas de bug mais n'arrive plus à afficher le feuille recap, reviens systématiquement sur la feuille stocks.

Moutchec.

gmb a écrit :

Bonjour à tous

Un autre essai à tester.

Bye !

bonjour,

ça marche bien mais difficile d'appliquer aux colonnes CH2 et BBC.

je m'y prend sans doute mal vu mes compétences limitées.

merci de m'aiguiller s'il vous plait.

salutations.

Moutchec.

EDIT si possible avec = Private Sub Worksheet_Activate() pour éviter le bouton

Bonsoir,

une idée, complète...

Sub calculer_1()
    Dim Cndt(2) As String
    Dim nbr As Double
    Dim n As Long
    Dim x As Long
    Dim y As Long
    Dim z As Long
    With Sheets(1)
        n = .Cells(Rows.Count, 2).End(xlUp).Row
        For x = 4 To 8 Step 2
            Cndt(1) = Cells(17, x)
            For y = 18 To 27
                nbr = 0
                Cndt(2) = Cells(y, 3)
                For z = 1 To n
                    If InStr(1, .Cells(z, 2), Cndt(1)) = 1 And InStr(1, .Cells(z, 5), Cndt(2)) = 1 Then nbr = nbr + .Cells(z, 8)
                Next z
                Cells(y, x) = nbr
            Next y
        Next x
    End With
End Sub

Nouvelle version.

Bye !

Sincères remerciements à tous,

vous êtes formidiables de savoir et de générosité.

petit à petit mon fichier progresse et moi avec!!!

merci.

Moutchec.