Transformer un code VBA

Le 21/04/2022 à 15:09

Bonjour, Je voudrai transformer un code vba

j'ai un tableau excel A1:I10 dans lequel sont inscrits des nombres.

Le code ci-dessous calcule sur toutes les lignes et colonnes de la feuille.

Je voudrai limiter les calculs sur ls limites du tableau A1:A10

Que faut-il transformer dans le code.

Option Explicit

Sub CALCUL()

Dim DL%, DC%, i%, L%, C%

Application.ScreenUpdating = False

With Sheets("RESULTAT")

DL = Range("C65500").End(xlUp).Row

DC = Cells(1, Columns.Count).End(xlToLeft).Column

' Copie liste nom en feuil2

.Cells.Clear

Range(Cells(1, 1), Cells(1, DC)).Copy

.[A1].PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Application.CutCopyMode = False

.Range("$A$1:$A$" & DC).RemoveDuplicates Columns:=1, Header:=xlNo

For i = 4 To DL

.Cells(1, i - 2) = Cells(i, "C")

Next i

DL = .Range("A65500").End(xlUp).Row

DC = .Cells(1, Columns.Count).End(xlToLeft).Column

For L = 2 To DL

For C = 2 To DC

.Cells(L, C).FormulaLocal = "=SIERREUR(ARRONDI(MOYENNE.SI.ENS(Feuil1!$F" & C + 2 & ":$ZZ" & C + 2 & ";Feuil1!$F$1:$ZZ$1;$A" & L & ");2);"""")"

Next C

Next L

End With

End Sub

Merci d'avance pour votre attention

Le 21/04/2022 à 15:18

Bonjour,

Lorsque vous postez un code dans votre demande, merci de bien vouloir utiliser les balises de code en cliquant sur l'icone </> dans la barre de menu et en collant votre code dans la fenêtre,

Cordialement

Le 21/04/2022 à 15:37
Option Explicit
Sub Calcul()
    Dim DL%, DC%, i%, L%, C%
    Application.ScreenUpdating = False
    With Sheets("Resultat")
        DL = Range("C65500").End(xlUp).Row
        DC = Cells(1, Columns.Count).End(xlToLeft).Column
        .Cells.Clear
        Range(Cells(1, 1), Cells(1, DC)).Copy
        .[A1].PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
        .Range("$A$1:$A$" & DC).RemoveDuplicates Columns:=1, Header:=xlNo
                For i = 4 To DL
            .Cells(1, i - 2) = Cells(i, "C")
        Next i
                DL = .Range("A65500").End(xlUp).Row
        DC = .Cells(1, Columns.Count).End(xlToLeft).Column
        For L = 2 To DL
            For C = 2 To DC
                .Cells(L, C).FormulaLocal = "=SIERREUR(ARRONDI(MOYENNE.SI.ENS(Feuil1!$F" & C + 2 & ":$ZZ" & C + 2 & ";Feuil1!$F$1:$ZZ$1;$A" & L & ");2);"""")"
            Next C
        Next L
    End With
End Sub

J'espère avoir compris, désolé pour mon ignorance.

Le 21/04/2022 à 15:59

J'espère avoir compris, désolé pour mon ignorance.

Oui je le vois. c'est juste que vous n'aviez pas lu certaines informations sur le fonctionnement dans ce forum

Pour votre code, je ne comprends pas ce que vous faites. Vous exécutez le code depuis quelle feuille ?

Sans données confidentielles

Crdlt

Le 22/04/2022 à 11:10

Re bonjour, je reprends le fil de mon message pour être plus explicite.

Je joins a cet effet un fichier essai.

Dans le code le calcul1 se fait sur toutes les lignes et les colonnes de la feuille1, les moyennes ne sont pas justes car elles comprennent les totaux des lignes et colonnes.

Il faudrait limiter le calcul au tableau B2-P10.

Bien entendu ce n'est pas moi qui ait créer ce code, sinon....

Merci d'avance pour votre aide

4essai.xlsm (27.19 Ko)
Le 22/04/2022 à 11:31

Ok mais vous ne répondez pas à la question de mon post précédent....

Le 22/04/2022 à 11:56

j'exécute le code depuis la feuille 1 et sur la feuille résultat j'ai les moyennes de tous les jours de la semaine.

Ce fichier essai n'est pas celui que j'utilise, qui est établit pour tous les mois et sur plus de lignes.

Le 22/04/2022 à 13:56

Merci des précisions

Essayez avec ce code modifié

Sub Calcul1()
Dim DL As Integer, DC As Integer, L As Integer, C As Integer

Sheets("Resultats").Cells.Clear

 With Sheets("Feuil1")
    .Select
    DL = .Range("C" & Rows.Count).End(xlUp).Row
    DC = .Cells(1, Columns.Count).End(xlToLeft).Column - 1
     .Range(Cells(1, 1), Cells(1, DC)).Copy
End With

With Sheets("Resultats")
    .Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    .Range("$A$1:$A$" & DC).RemoveDuplicates Columns:=1, Header:=xlNo

    For L = 4 To DL
        .Cells(1, L - 2) = Sheets("Feuil1").Cells(L, "C")
    Next L

    DL = .Range("A" & Rows.Count).End(xlUp).Row
    DC = .Cells(1, Columns.Count).End(xlToLeft).Column

    For L = 2 To DL
        For C = 2 To DC
            .Cells(L, C).FormulaLocal = "=SIERREUR(ARRONDI(MOYENNE.SI.ENS(Feuil1!$F" & C + 2 & ":$ZZ" & C + 2 & ";Feuil1!$F$1:$ZZ$1;$A" & L & ");2);"""")"
        Next C
    Next L
End With
End Sub

Autre point la 1iere ligne de votre code dans la feuille Resultat est à modifier -->

Private Sub Worksheet_Activate()

Attention aussi avec l'instruction Enebleevents car si votre code plante au milieu de votre macro Activate, vous perdrez l'exécution des événements dans Excel.

Le code Transposition pourrait être aussi revu je pense et y intégrant peut être le code Calcul2

EDIT : J'ai changé le code ci-dessus. Une fois fait vous pouvez supprimer la ligne Sheets("Feuil1").Select qui se trouve dans la Private sub Activate

Le 22/04/2022 à 16:32

Ah..fil cloturé sans commentaires et comme on est jamais mieux servi que par soi même

Merci Dan !

Rechercher des sujets similaires à "transformer code vba"