Reproduction de tableau avec calcul incorpore

A

Ardamire

XLDnaute Nouveau
Bonjour a toutes et tous,

Voila je me suis permis de joindre un fichier dans lequel j'expose les details de mon probleme mais pour resumer j'ai un tableau source contenant plusieurs donnees.

Mon objectif est de "reproduire" ce tableau une colonne plus loin mais en effectuant un calcul pour certaines colonnes. Les calculs sont simples mais en fait, je souhaiterais l'aide d'une macro car les differentes donnees sont separees par une ligne vierge qui servirait de "borne" pour terminer les calculs des premieres donnees et egalement pour commencer le calcul des suivantes.

Un autre element serait d'effectuer une recherche a partir de cette ligne pour selectionner un parametre du calcul (definit dans la feuille Excel).

Les plages de donnes pouvant etre tres variables d'une fois a l'autre, la ligne de separation est assez interessante pour pouvoir "traiter" le sujet d'autant plus qu'il s'agit du format de sortie des donnees brutes.

D'avance merci pour votre aide et j'espere avoir ete suffisamment explicite ... si pas, j'essayerai de repondre au plus vite et le plus precisement possible a vos questions.

Ardamire.
 

Pièces jointes

  • Problem_Macro.xls
    23.5 KB · Affichages: 100
  • Problem_Macro.xls
    23.5 KB · Affichages: 93
  • Problem_Macro.xls
    23.5 KB · Affichages: 97
Trier par date Trier par votes
CISCO

CISCO

XLDnaute Barbatruc
Re : Reproduction de tableau avec calcul incorpore

Bonjour à tous

Je sais faire ce que tu demandes avec des formules, pas avec une macro.

Toutefois, avant de m'y mettre, quelques questions :
Pourquoi vas tu "piocher" C3 et pas C1 ou C2 pour le tableau du haut, et C14 et pas... pour le tableau du bas. Est-ce une variable, où est-ce que cela sera toujours C3 et C14 ?

Dans ton tableau réel, as tu plus de colonnes, un nombre de colonnes variables, beaucoup, beaucoup de lignes ?

@ plus
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : Reproduction de tableau avec calcul incorpore

Bonjour Ardamir, Cisco : ) ,
Une proposition qui ne fnctionne que si la premiére ligne est vide et si la feuille ne contient que les tableaux à traiter (Je sais, ça fait pas mal de si mais je ne vois pas d'autre idée)
VB: 
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Columns("H:M").ClearContents
LstCol = ActiveSheet.UsedRange.Columns.Count
Plg = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, LstCol)).Value
Set Dico = CreateObject("Scripting.Dictionary")
For i = LBound(Plg, 1) To UBound(Plg, 1)
   If Plg(i, 1) = "" Then Dico(i) = i
Next i
Tablig = Dico.Keys
For a = LBound(Tablig) To UBound(Tablig) - 1
    FrstLig = Tablig(a)
    z = 0: Multi = Plg(FrstLig + 3, 2)
    For k = 2 To LstCol Step 2
        z = z + 1
        Plg(FrstLig + 5, k) = "Unite " & LstCol + z
        For b = 1 To (Tablig(a + 1) - FrstLig) - 6
            Plg(FrstLig + 5 + b, k) = Plg(FrstLig + 5 + b, k) / Multi
        Next b
    Next k
Next a
Cells(1, 8).Resize(UBound(Plg, 1), UBound(Plg, 2)) = Plg
Application.ScreenUpdating = True
End Sub
Cordialement

EDIT ...Et si tous les tableaux ont le même nombre de colonnes (ça commence à faire très beaucoups de si ...
 

Pièces jointes

  • Problem_Macro(2).xls
    47 KB · Affichages: 55
  • Problem_Macro(2).xls
    47 KB · Affichages: 58
  • Problem_Macro(2).xls
    47 KB · Affichages: 58
Dernière édition:
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : Reproduction de tableau avec calcul incorpore

Re
Ca s'améliore, un peu...
Plus de problèmes avec les nombres de colonnes (chaque tableau peut avoir un nombre différent).
Pour l'instant je m'arrete là, en attendant un premier retour (je suis assez interressé par les mêmes questions que Cisco).
VB: 
Private Sub CommandButton1_Click()
Dim LstCol&, i&, LstColTab&, FrstLig&, z&, c&, a&, Multi&, k&, b&
Dim Plg, Dico, TabLig
Application.ScreenUpdating = False
Columns("K:S").ClearContents
LstCol = ActiveSheet.UsedRange.Columns.Count
Plg = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, LstCol)).Value
Set Dico = CreateObject("Scripting.Dictionary")
For i = LBound(Plg, 1) To UBound(Plg, 1)
   If Plg(i, 1) = "" Then Dico(i) = i
Next i
TabLig = Dico.Keys
For a = LBound(TabLig) To UBound(TabLig) - 1
    LstColTab = 0
    FrstLig = TabLig(a)
    z = 0: Multi = Plg(FrstLig + 3, 2)
    For c = 1 To LstCol
        If Plg(FrstLig + 5, c) <> "" Then LstColTab = LstColTab + 1
    Next c
    For k = 2 To LstColTab Step 2
        z = z + 1
        Plg(FrstLig + 5, k) = "Unite " & LstColTab + z
        For b = 1 To (TabLig(a + 1) - FrstLig) - 6
            Plg(FrstLig + 5 + b, k) = Plg(FrstLig + 5 + b, k) / Multi
        Next b
    Next k
Next a
Cells(1, 11).Resize(UBound(Plg, 1), UBound(Plg, 2)) = Plg
Application.ScreenUpdating = True
End Sub
Cordialement
 

Pièces jointes

  • Problem_Macro(3).xls
    40 KB · Affichages: 71
Dernière édition:
Vote positif 0 Vote négatif
A

Ardamire

XLDnaute Nouveau
Re : Reproduction de tableau avec calcul incorpore

Bonjour CISCO,

Je vais essayer de répondre au mieux à tes interrogations :)

CISCO à dit:
Pourquoi vas tu "piocher" C3 et pas C1 ou C2 pour le tableau du haut, et C14 et pas... pour le tableau du bas. Est-ce une variable, où est-ce que cela sera toujours C3 et C14 ?

@ plus
Cliquez pour agrandir...

Donc C3 est un facteur de conversion alors que C1 et C2 sont des paramètres de définition. Donc C3 est un facteur de conversion spécifique au premier tableau, C14 pour le second tableau ... et ainsi de suite pour plusieurs tableaux consécutifs qui peuvent avoir un nombre de lignes différent c'est la raison pour laquelle la ligne vierge entre 2 tableaux permet de faire la distinction.

CISCO à dit:
Dans ton tableau réel, as tu plus de colonnes, un nombre de colonnes variables, beaucoup, beaucoup de lignes ?

@ plus
Cliquez pour agrandir...

Dans le tableau réel, j'aurai au mieux (ou au pire :D) 2 fois ce nombre de colonnes mais ce sera toujours "fixe". En revanche, le nombre de ligne pourra être incrémenté jusqu'à 5000 voir un peu plus.

Si c'est pas suffisamment clair, tiens-moi au courant.

Merci.
 
Vote positif 0 Vote négatif
A

Ardamire

XLDnaute Nouveau
Re : Reproduction de tableau avec calcul incorpore

Bonjour Efgé,

Efgé à dit:
Re
Ca s'améliore, un peu...
Plus de problèmes avec les nombres de colonnes (chaque tableau peut avoir un nombre différent).
Pour l'instant je m'arrete là, en attendant un premier retour (je suis assez interressé par les mêmes questions que Cisco).
Cliquez pour agrandir...

Désolé, je traite les messages dans l'ordre ;0)

Donc en fait, mon nombre de colonne sera fixé au départ et ne bougera plus donc ce sera soit la configuration initiale envoyée ou un nombre de colonne doublé. En revanche, le nombre de lignes sera élevé et différent pour les différents tableaux de la page.

Mon idée est, à partir de ces valeurs calculées, de tracer des graphiques via macro qui reconnaissent la fameuse ligne vierge pour le plotstart et le plotend. J'ai repris une base existante que j'ai modifié et qui ne fonctionne pas mal. Je ne l'ai pas ici mais demain, je mettrai le code sur le forum.

A bientôt.

Ardamire.
 
Vote positif 0 Vote négatif
A

Ardamire

XLDnaute Nouveau
Re : Reproduction de tableau avec calcul incorpore

Bonjour a tous,

Premierement, veuillez m'excuser pour les fautes d'orthographe mais c'est un clavier UK au travail :p

Donc voici comme convenu le code VBA que j'adapte a mes besoins mais dont je ne comprends pas forcement tous les tenants et aboutissants. J'essaie de mettre pas mal de commentaires pour m'y retrouver mais il y a probablement un moyen de reduire les lignes de codes utilisees ... mais on va faire une chose a la fois :)

Je vais essayer d'integrer ce que vous m'avez deja envoye.

Code VBA:

Code: 
'***********************Rowlookup********************************
'Set start of data table
datarowstart = 4    'rownumber start of data, row 6
datacolumnstart = 1 'column number start of data, 4 Column A
emptyrow = 0
datarowmax = 5500   'changed while the initial value was 5000'
activerow = datarowstart
activecolumn = datacolumnstart
loopcnt = 0
Delta = 0
Plotname_xxx = 0
Plotname_yyy = 0

Do
    loopcnt = loopcnt + 1
    If loopcnt = 1 Then
        plotstart = 4   'define the row where the first data are taken'
    Else
        plotstart = plotend + 5
       'Find Empty Row for start plot range
        'Do
            activerow = activerow + 1
            
        'Loop Until IsEmpty(ActiveSheet.Cells(activerow, activecolumn)) Or activerow = datarowmax
        'Emptyrow = activerow
        'Plotstart = Emptyrow + 2
    End If
    
    ' To read the right cells for creating the plot name (YYY)
    activerow = plotstart - 3                       'To set to right row for plotname
    activecolumn = datacolumnstart + 1              'To set to Column B
    Plotname_xxx = Worksheets("Sheet's name").Cells(activerow, activecolumn) ' To read the name to mme for the plot from the sheet
    
    ' To read the right cells for creating the plot name (FFFF)
    activerow = plotstart - 2                       'To set to right row for plotname
    activecolumn = datacolumnstart + 1              'To set to Column B
    Plotname_yyy = Worksheets("Sheet's name").Cells(activerow, activecolumn) ' To read the name to mme for the plot from the sheet
    
    'Find Empty Row for end plot range
    activerow = plotstart
    activecolumn = datacolumnstart             'set back to Column A
    
    Do
        activerow = activerow + 1
        'datav = Worksheets("data").Cells(activerow, activecolumn)
    Loop Until IsEmpty(ActiveSheet.Cells(activerow, activecolumn)) Or activerow = datarowmax
           emptyrow = activerow
            plotend = emptyrow - 1
    
    Delta = plotend - plotstart
    
    
    
 '***********************Plot data********************************
 If Delta > 10 Then
    
    'Plot Macro
    Range("A" & plotstart & ":F" & plotend).Select
    Range(Selection, Selection.End(xlDown)).Select
    Charts.Add
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SetSourceData Source:=Sheets("Sheet's name").Range("A" & plotstart & ":L" & plotend), PlotBy:= _
            xlColumns
    ActiveChart.Location Where:=xlLocationAsNewSheet
        With ActiveChart
        .HasTitle = True
        '.ChartTitle.Characters.Text = "TITLE"
        .ChartTitle.Characters.Text = "YYY: " & Plotname_xxx & " aaaa" & "  FFFF: " & Plotname_yyy & " bbbb"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Y axis name [mm]"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "X axis name [ttt]"
    End With
    ActiveChart.ChartTitle.Select 'Font of the plot title'
    Selection.Font.Underline = xlUnderlineStyleSingle
    Selection.AutoScaleFont = True
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleSingle
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    ActiveChart.SeriesCollection(4).Select  'Delete the column E'
    Selection.Delete
    ActiveChart.SeriesCollection(2).Select 'Delete the column D'
    Selection.Delete
    ActiveChart.SeriesCollection(6).Select  'Delete the column I'
    Selection.Delete
    ActiveChart.SeriesCollection(7).Select 'Delete the column K'
    Selection.Delete
    ActiveChart.SeriesCollection(4).Select  'Delete the column G'
    Selection.Delete
     ActiveChart.SeriesCollection(1).Select  'Defines the layout of the trace 1'
    With Selection.Border
        .ColorIndex = 5 'Blue Color for trace 1'
        .Weight = xlThin
        .LineStyle = xlContinuomm
    End With
     ActiveChart.SeriesCollection(2).Select  'Defines the layout of the trace 2'
    With Selection.Border '
        .ColorIndex = 3 'Red Color for trace 2'
        .Weight = xlThin
        .LineStyle = xlContinuomm
    End With
     ActiveChart.SeriesCollection(3).Select  'Defines the layout of the trace 3'
    With Selection.Border
        .ColorIndex = 4 'Green Color for trace 3'
        .Weight = xlThin
        .LineStyle = xlContinuomm
    End With
    With Selection
        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlNone
        .MarkerStyle = xlNone
        .Smooth = True
        .MarkerSize = 3
        .Shadow = False
    End With
    ActiveChart.Axes(xlCategory).Select
    With ActiveChart.Axes(xlCategory)
        .HasMajorGridlines = True   'Had the major gridlines on the X-axis'
        .HasMinorGridlines = False
        .MinimumScale = 150
        .MaximumScale = 550
        .MinorUnitIsAuto = True
        .MajorUnit = 25
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
    ActiveChart.Axes(xlCategory).MajorGridlines.Select
    With Selection.Border
        .ColorIndex = 16    'Define the gridline shape and color of the X-axis'
        .Weight = xlHairline
        .LineStyle = xlDot
    End With
    ActiveChart.PlotArea.Select
    Selection.Top = 25
    Selection.Height = 409
    Selection.Width = 584
    Selection.Interior.ColorIndex = xlAutomatic
    With Selection.Border   'The plot area is colored in white'
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuomm
    End With
    ActiveChart.Axes(xlValue).Select
    With ActiveChart.Axes(xlValue)
        .HasMajorGridlines = True   'Had the major gridlines on the Y-axis'
        .HasMinorGridlines = False
        .MinimumScale = 0
        .MaximumScale = 4
        .MinorUnitIsAuto = True
        .MajorUnit = 0.5
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    With Selection.Border
        .ColorIndex = 16    'Define the gridline shape and color of the Y-axis'
        .Weight = xlHairline
        .LineStyle = xlDot
    End With
    Sheets("Sheet's name").Select 'To go back to the Sheet's name
    Range("J9").Select                  'To go back to top of sheet
 End If
Loop Until Delta < 10
End Sub
Merci pour votre aide.
 
Dernière édition:
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : Reproduction de tableau avec calcul incorpore

Bonjour à tous,
Jeter un code comme ça dans un post est particulièrement indigeste :rolleyes: il existe des balises (#)...
D'autre part il manque des morceaux (pas de début ni de fin).
Pour finir vous n'expliquez pas les tenants et les boutissants de ce long, très long, code.
Enfin bref, je passe la main à plus courageux que moi.
Cordialement
 
Vote positif 0 Vote négatif
A

Ardamire

XLDnaute Nouveau
Re : Reproduction de tableau avec calcul incorpore

Efgé à dit:
Bonjour à tous,
Jeter un code comme ça dans un post est particulièrement indigeste :rolleyes: il existe des balises (#)...
Cliquez pour agrandir...

Desole, j'ai essaye de faire vite et bien. Il semble que seulement le premier qualificatif soit applicable.

Efgé à dit:
D'autre part il manque des morceaux (pas de début ni de fin).
Cliquez pour agrandir...

Il s'agit du code tel que je le manipule actuellement et je ne vois pas ce que vous appelez "debut et fin"

Efgé à dit:
Pour finir vous n'expliquez pas les tenants et les boutissants de ce long, très long, code.
Cliquez pour agrandir...

Code code est utilise pour creer des graphiques de facon automatique pour les donnees inserees dans le tableau. La premiere partie du code "Row lookup" definit la position des premieres donnees traitees et egalement que la ligne vierge separant 2 series est un repere. La seconde partie concerne la mise en forme des graphiques avec la selection des series utiles et tous les renseignements utiles a la comprehension du graphique.

Efgé à dit:
Enfin bref, je passe la main à plus courageux que moi.
Cordialement
Cliquez pour agrandir...

Desole de vous avoir decourage et merci pour votre aide.

Bonne journee.

Cedric
 
Vote positif 0 Vote négatif
A

Ardamire

XLDnaute Nouveau
Re : Reproduction de tableau avec calcul incorpore

Efgé à dit:
Re
VB: 
Private Sub CommandButton1_Click()
Dim LstCol&, i&, LstColTab&, FrstLig&, z&, c&, a&, Multi&, k&, b&
Dim Plg, Dico, TabLig
Application.ScreenUpdating = False
Columns("K:S").ClearContents
LstCol = ActiveSheet.UsedRange.Columns.Count
Plg = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, LstCol)).Value
Set Dico = CreateObject("Scripting.Dictionary")
For i = LBound(Plg, 1) To UBound(Plg, 1)
   If Plg(i, 1) = "" Then Dico(i) = i
Next i
TabLig = Dico.Keys
For a = LBound(TabLig) To UBound(TabLig) - 1
    LstColTab = 0
    FrstLig = TabLig(a)
    z = 0: Multi = Plg(FrstLig + 3, 2)
    For c = 1 To LstCol
        If Plg(FrstLig + 5, c) <> "" Then LstColTab = LstColTab + 1
    Next c
    For k = 2 To LstColTab Step 2
        z = z + 1
        Plg(FrstLig + 5, k) = "Unite " & LstColTab + z
        For b = 1 To (TabLig(a + 1) - FrstLig) - 6
            Plg(FrstLig + 5 + b, k) = Plg(FrstLig + 5 + b, k) / Multi
        Next b
    Next k
Next a
Cells(1, 11).Resize(UBound(Plg, 1), UBound(Plg, 2)) = Plg
Application.ScreenUpdating = True
End Sub
Cordialement
Cliquez pour agrandir...

J'ai essaye ce code qui fonctionne tres bien quelque soit le nombre de ligne que j'y ajoute. Merci.

En revanche, en verifiant le calcul, je m'apercois que le coefficient est utilise comme un nombre entier pas un nombre decimal ce qui induit une erreur. Pouvez-vous me dire comme renseigner ce detail pour le coefficient intitule "Multi"?

Merci
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : Reproduction de tableau avec calcul incorpore

Re
J'ai trouvé :
Il faut déclarer Multi comme variant
Code: 
Dim Multi As Variant
Comme quoi, le conseil de Pierre-Jean est à re-méditer:
Mieux vaux ne pas déclarer les variables, que de les mal déclarer.
Cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
XL 2021 creer une export tableau dynamique via VBA et avec des criteres pre defini
Réponses
1
Affichages
143
pasquetp
P
D
  • Question
XL 2021 Formulaire de calcul des jours proratisés
Réponses
0
Affichages
194
Did25
D
C
  • Question
Calcul à partir de dates
2
Réponses
23
Affichages
2 K
CathU
C
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Affichage des résultats dans un tableau selon des conditions
Réponses
13
Affichages
307
chaelie2015
chaelie2015
M
  • Résolu(e)
XL 2021 calcul de cotations
Réponses
8
Affichages
305
Mouchette
M
O
  • Question
Power Query Convertir un tableau de colonnes en lignes avec plusieurs variables (power query)
Réponses
8
Affichages
371
oobiz
O
A
  • Résolu(e)
XL 2021 Calcule consommation de carburant
Réponses
3
Affichages
322
ayoub456
A
C
  • Question
XL 2019 Récupérer titre de ligne et colonne quand une cellule est rempli dans un tableau
Réponses
3
Affichages
126
Clemee61
C
Mathmath06
  • Question
XL 2016 Calcul écart de combinaison de 4 numéros Keno
2
Réponses
15
Affichages
707
Mathmath06
Mathmath06
B
  • Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
321
job75
job75

Membres actuellement en ligne

5 membres et 45 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
312 229
Messages
2 086 424
Membres
103 206
dernier inscrit
diambote