Graphique avec intervalles irréguliers (cellules vides) [Résolu/Fermé]

Signaler
Messages postés
6
Date d'inscription
samedi 7 février 2015
Statut
Membre
Dernière intervention
18 février 2015
-
cockrille
Messages postés
6
Date d'inscription
samedi 7 février 2015
Statut
Membre
Dernière intervention
18 février 2015
-
Bonjour,

j'aurais une question pour établir un graphique avec des cellules vides.




Comme vous pouvez le voir sur l'image, ca serait pour faire un graphique en batonnet avec en abscisse le nombre opérateur(F) opérateurs et en ordonnée la somme cumulée des temps de travails (I ou J).

J'ai pas mal cherché sur internet mais avec mon code,au lieu de selectionner les cellules non vides, il les écrits dans F2

Si quelqu'un disposait d'un code pour sélectionner seulement les cellules pleines et ensuite etablir un graphique ca m'aiderait beaucoup :)

Mon code:

Sub CreateChart()
Dim A As String
Dim abscisse As range
Dim ordonnee As range
'Dim NCol1 As Integer
' NCol1 = 6
'Dim NCol2 As Integer
' NCol2 = 10

range("F1,J1").Select
range(Selection, Selection.End(xlDown)).Select
'A = Union(Cells(2, NCol1), Cells(2, NCol2)).EntireColumn.Select
abscisse = Remplir1()
ordonnee = Remplir2()
A = Union(abscisse, ordonnee).Select
Charts.Add
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Sheets("Graphique1").range(A), PlotBy:=xlColumns

End Sub

Function Remplir1() As range

Dim rang As range
Set rang = range("F2")
Dim j As Integer

'Récupère les données de la colonne F...
For j = 3 To range("F65536").End(xlUp).Row
If Not IsEmpty(range("F" & j)) Then
rang = rang + range("F" & j)
'ComboBox1 = range("F" & j)
'...et filtre les doublons
'If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem range("A" & j)
End If
Next j

End Function

Function Remplir2() As range

Dim j As Integer

'Récupère les données de la colonne J...
For j = 1 To range("J65536").End(xlUp).Row
If Not IsEmpty(range("J" & j)) Then
ComboBox1 = range("J" & j)
'...et filtre les doublons
If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem range("A" & j)
End If
Next j

End Function

1 réponse

Messages postés
6
Date d'inscription
samedi 7 février 2015
Statut
Membre
Dernière intervention
18 février 2015

Problème résolu,

Pour ceux qui veulent mon code:

Sub Graphique()

Dim A As String


Worksheets("Découpes").range("F:F").SpecialCells(xlCellTypeConstants, 23).Copy
Worksheets("Graphique").range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Worksheets("Découpes").range("J:J").SpecialCells(xlCellTypeConstants, 23).Copy
Worksheets("Graphique").range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

range("A1").Select
Selection.CurrentRegion.Select
Charts.Add
'ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Sheets("Graphique").range("A:B"), PlotBy _
:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Graphique"

With ActiveSheet.ChartObjects(1)
.Left = range("D2:S40").Left
.Top = range("D2:S40").Top
.Width = range("D2:S40").Width
.Height = range("D2:S40").Height
.Parent.Name = "Graphique"
End With

Worksheets("Graphique").Columns("A:B").ColumnWidth = 30

End Sub