Bonsoir je désire effectuer trois tableau Scatter Dynamique distinct
RCP1 RCP2 RCP3
A partir de datas d’une feuille onglet « Graph PARAMS » à partir de la ligne 104
Et exclure les lignes d’avant et les datas peuvent atteindre la ligne 1800
Comment procéder pour que WaferNum puisse etre plus ou moins extensible
Et fonctionne quelque soit les datas présent ou absent
Ci-joint une Macro que j’ai essayé sur RCP1 seul
Avec comme seul donner au nombre de 3 Wafernum / X/ Y
Cela fonctionne
********************************************************
Sub Test()
Dim graphXY As Chart, nouvSerie As Series, i As Long, cpt As Long, feuilSource As Worksheet, zoneGraphique As Range
Dim tabSeries() As Variant, dicoSeries As Object, nbSeries As Long, nbPts As Long, tabValX() As Double, tabValY() As Double, derLig As Long, zoneSeries As Range, cellR As Range, memAdr As String
'initialiser les variables
Set feuilSource = ThisWorkbook.Sheets("Data")
Set zoneGraphique = feuilSource.Range("F20:M35")
'récupérer la liste des séries (colonne A)
derLig = feuilSource.Cells(feuilSource.Rows.Count, 1).End(xlUp).Row
Set dicoSeries = CreateObject("Scripting.Dictionary")
On Error Resume Next
For i = 2 To derLig
dicoSeries.Add feuilSource.Cells(i, 1).Text, feuilSource.Cells(i, 1).Text
Next i
On Error GoTo 0
tabSeries = dicoSeries.Items
'créer un nouveau graphique (de type XY Scatter)
With zoneGraphique
Set graphXY = .Parent.ChartObjects.Add(.Left, .Top, .Width, .Height).Chart
End With
graphXY.ChartType = xlXYScatter
Set zoneSeries = feuilSource.Range(feuilSource.Cells(2, 1), feuilSource.Cells(derLig, 1))
'boucler sur chaque série
For i = LBound(tabSeries) To UBound(tabSeries)
'récupérer les points de la série
nbPts = WorksheetFunction.CountIf(zoneSeries, tabSeries(i))
ReDim tabValX(1 To nbPts)
ReDim tabValY(1 To nbPts)
cpt = 0
Set cellR = zoneSeries.Find(tabSeries(i), , xlValues, xlWhole)
If Not cellR Is Nothing Then
memAdr = cellR.Address
Do
cpt = cpt + 1
tabValX(cpt) = cellR.Offset(0, 1).Value
tabValY(cpt) = cellR.Offset(0, 2).Value
Set cellR = zoneSeries.FindNext(cellR)
Loop Until cellR.Address = memAdr
End If
'ajouter la série au graphique
Set nouvSerie = graphXY.SeriesCollection.NewSeries
nouvSerie.Name = tabSeries(i)
nouvSerie.XValues = tabValX
nouvSerie.Values = tabValY
Next i
End Sub
*********************************************
Avec trois tableau plus les lim hautes et basse de chaque Axe
Cela se corse
Merci de votre Aide
RCP1 RCP2 RCP3
A partir de datas d’une feuille onglet « Graph PARAMS » à partir de la ligne 104
Et exclure les lignes d’avant et les datas peuvent atteindre la ligne 1800
Comment procéder pour que WaferNum puisse etre plus ou moins extensible
Et fonctionne quelque soit les datas présent ou absent
Ci-joint une Macro que j’ai essayé sur RCP1 seul
Avec comme seul donner au nombre de 3 Wafernum / X/ Y
Cela fonctionne
********************************************************
Sub Test()
Dim graphXY As Chart, nouvSerie As Series, i As Long, cpt As Long, feuilSource As Worksheet, zoneGraphique As Range
Dim tabSeries() As Variant, dicoSeries As Object, nbSeries As Long, nbPts As Long, tabValX() As Double, tabValY() As Double, derLig As Long, zoneSeries As Range, cellR As Range, memAdr As String
'initialiser les variables
Set feuilSource = ThisWorkbook.Sheets("Data")
Set zoneGraphique = feuilSource.Range("F20:M35")
'récupérer la liste des séries (colonne A)
derLig = feuilSource.Cells(feuilSource.Rows.Count, 1).End(xlUp).Row
Set dicoSeries = CreateObject("Scripting.Dictionary")
On Error Resume Next
For i = 2 To derLig
dicoSeries.Add feuilSource.Cells(i, 1).Text, feuilSource.Cells(i, 1).Text
Next i
On Error GoTo 0
tabSeries = dicoSeries.Items
'créer un nouveau graphique (de type XY Scatter)
With zoneGraphique
Set graphXY = .Parent.ChartObjects.Add(.Left, .Top, .Width, .Height).Chart
End With
graphXY.ChartType = xlXYScatter
Set zoneSeries = feuilSource.Range(feuilSource.Cells(2, 1), feuilSource.Cells(derLig, 1))
'boucler sur chaque série
For i = LBound(tabSeries) To UBound(tabSeries)
'récupérer les points de la série
nbPts = WorksheetFunction.CountIf(zoneSeries, tabSeries(i))
ReDim tabValX(1 To nbPts)
ReDim tabValY(1 To nbPts)
cpt = 0
Set cellR = zoneSeries.Find(tabSeries(i), , xlValues, xlWhole)
If Not cellR Is Nothing Then
memAdr = cellR.Address
Do
cpt = cpt + 1
tabValX(cpt) = cellR.Offset(0, 1).Value
tabValY(cpt) = cellR.Offset(0, 2).Value
Set cellR = zoneSeries.FindNext(cellR)
Loop Until cellR.Address = memAdr
End If
'ajouter la série au graphique
Set nouvSerie = graphXY.SeriesCollection.NewSeries
nouvSerie.Name = tabSeries(i)
nouvSerie.XValues = tabValX
nouvSerie.Values = tabValY
Next i
End Sub
*********************************************
Avec trois tableau plus les lim hautes et basse de chaque Axe
Cela se corse
Merci de votre Aide
