Adattare un grafico per interpretazione corretta

[raimea]

ciao
tramite la macro graficodiario
realizzo un grafico con dei valori che sono nelle col BC:BD del fgl diario

Codice: Seleziona tutto

Sub graficodiario()

 
ActiveSheet.Unprotect
If gg = 0 Then
'--------------------------------
' Dim gg As Long    <<< da mettere Rigorosamente in testa al Modulo
'---------------------------
   If [c7] = "" Then
         MsgBox "il diario non ha nessuna data...", vbCritical
       
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True
       
      Exit Sub
    End If
'-----------------------------
    Dim r
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Graf. Nascondi"
   
   
    If Cells(7, 3) = "" Then Exit Sub    ' cell c7
    r = Cells(2, 16) + Cells(3, 16) + 3  ' celle p2 e p3
   
    ActiveSheet.ChartObjects("Grafico 14").Visible = True
    ActiveSheet.ChartObjects("Grafico 14").Activate

'--in col BD ci sono i valori--

    ActiveChart.SeriesCollection(1).Values = "='diario1'!$bd$7:$bd$" & r + 3  '3 numero da variare secondo i casi
    ActiveChart.SeriesCollection(1).XValues = "='diario1'!$bb$7:$bc$15" & r + 3
   
    Cells(1, 1).Select
    gg = 1
   
Else
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Graf. Vedi"
   
    ActiveSheet.ChartObjects("Grafico 14").Visible = False
    Cells(1, 1).Select
    gg = 0


End If

       
Range("a20").Select
End Sub


ma ora che ho molti dati
il grafico diventa di difficile interprezione e i valori tendono a sovrapporsi

vorrei riuscire a far si di NON prelevare tutti i dati ma con degli step
ogni 4/5 caselle, in modo che il grafico diventi di facile interpretazione


vi allego il file
https://www.dropbox.com/s/mkog0m55am24knx/step.rar?dl=0

grazie

[Anthony47]

Ho modificato la tua Sub Graficodiario in modo che usi due array per popolare i grafici, invece che i range del foglio.
La variabile maxXY (che trovi a meta' della macro) indica il numero max di elementi da visualizzare; se ne sono presenti in quantita' superiore la macro fa uno scaling in proporzione.
Ad uso dimostrativo ho impostato maxXY = 10, tu imposta il valore che preferisci.

Codice: Seleziona tutto

Sub graficodiario()

 ActiveSheet.Unprotect
If gg = 0 Then
'--------------------------------
' Dim gg As Long    <<< da mettere Rigorosamente in testa al Modulo
'---------------------------
   If [c7] = "" Then
         MsgBox "il diario non ha nessuna data...", vbCritical
       
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True
       
      Exit Sub
    End If
'-----------------------------
    Dim r
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Graf. Nascondi"
   
   
    If Cells(7, 3) = "" Then Exit Sub    ' cell c7
    r = Cells(2, 16) + Cells(3, 16) + 3  ' celle p2 e p3
   
    ActiveSheet.ChartObjects("Grafico 14").Visible = True
    ActiveSheet.ChartObjects("Grafico 14").Activate

    '>>>Da qui in avanti e' modificato:
    '--in col BD ci sono i valori--
    Dim xArr(), yArr() As Single, maxXY As Long, cXY, rFatt As Single
    maxXY = 10          '<<< Il numero max di valori da visualizzare
    cXY = Application.WorksheetFunction.Count(Sheets("diario1").Range("BC7").Resize(1000, 1))
    If cXY > maxXY Then
        rFatt = cXY / maxXY
        ReDim xArr(0 To maxXY)
        ReDim yArr(0 To maxXY)
    Else
        rFatt = 1
        ReDim xArr(0 To cXY)
        ReDim yArr(0 To cXY)
    End If
    For i = 0 To cXY - 1 Step rFatt
        xArr(i / rFatt) = Sheets("diario1").Range("BC7").Offset(i, 0)
        yArr(i / rFatt) = Sheets("diario1").Range("BD7").Offset(i, 0)
   
    Next i
   
    ActiveChart.SeriesCollection(1).Values = yArr
    ActiveChart.SeriesCollection(1).XValues = xArr
    '    ActiveChart.SeriesCollection(1).Values = "='diario1'!$bd$7:$bd$" & r + 3  '3 numero da variare secondo i casi
    '    ActiveChart.SeriesCollection(1).XValues = "='diario1'!$bb$7:$bc$15" & r + 3
    '<<< FINE MODIFICHE
    Cells(1, 1).Select
    gg = 1
Else
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Graf. Vedi"
    ActiveSheet.ChartObjects("Grafico 14").Visible = False
    Cells(1, 1).Select
    gg = 0
End If

Range("a20").Select
End Sub


Tuttavia, secondo me, l'errore e' voler rappresentare le etichette (un elemento analitico, il numero) sul grafico (un elemento analogico); io toglierei le etichette e visualizzerei sull'asse Y le righe dell'unita' principale e forse anche secondaria.

Ciao

[raimea]

ciao
ottimo tutto ok

ora potendo decidere quanti valori visualizzare
il grafico e' di facile interpretazione.

vedo rispetto a prima :
che la linea del grafico a fine valori va sull' asse al valore zero
mentre prima si fermava (giustamente) all'ultimo valore della tabella
senza tornare a zero

si potrebbe far si' che la linea_grafico si fermi all' ultimo valore della tabella ?


per le etichette al momento preferisco lasciarle.

grazie

[Anthony47]

Oggi non posso provare, prova a modificare le 4 redim da (0 to valore) a
(0 to valore -1)

Io potrò vedere solo stasera tardi
Ciao

[raimea]

ciao
ho provato

Codice: Seleziona tutto

 
    Dim xArr(), yArr() As Single, maxXY As Long, cXY, rFatt As Single
    maxXY = 13                  '<<< Il numero max di valori da visualizzare
    cXY = Application.WorksheetFunction.Count(Sheets("diario1").Range("BC7").Resize(1000, 1))
    If cXY > maxXY Then
        rFatt = cXY / maxXY
        ReDim xArr(0 To valore - 1)
        ReDim yArr(0 To valore - 1)
    Else
        rFatt = 1
        ReDim xArr(0 To valore - 1)
        ReDim yArr(0 To valore - 1)
    End If
    For i = 0 To cXY - 1 Step rFatt
        xArr(i / rFatt) = Sheets("diario1").Range("BC7").Offset(i, 0)
        yArr(i / rFatt) = Sheets("diario1").Range("BD7").Offset(i, 0)
   
    Next i
   

ma da errore

ciao

[Anthony47]

Eh eh, io intendevo

Codice: Seleziona tutto

    If cXY > maxXY Then
        rFatt = cXY / maxXY
        ReDim xArr(0 To maxXY -1)
        ReDim yArr(0 To maxXY -1)
    Else
        rFatt = 1
        ReDim xArr(0 To cXY -1)
        ReDim yArr(0 To cXY -1)
    End If


Comunque l'equivoco nasce dal fatto che in colonna BC (le date) l'ultima data riporta in colonna BD il valore 0

Ho preferito quindi calcolare il numero di elementi da predisporre guardando la colonna BB, che mi sembra allineata col contenuto di BD; ho comunque rivisto il ciclo di caricamento dell'array per evitare situazioni impreviste coi decimali. La "penultima" versione della Sub graficodiario e' quindi diventata:

Codice: Seleziona tutto

Sub graficodiario()

 ActiveSheet.Unprotect
If gg = 0 Then
'--------------------------------
' Dim gg As Long    <<< da mettere Rigorosamente in testa al Modulo
'---------------------------
   If [c7] = "" Then
         MsgBox "il diario non ha nessuna data...", vbCritical
       
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True
       
      Exit Sub
    End If
'-----------------------------
    Dim r
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Graf. Nascondi"
   
   
    If Cells(7, 3) = "" Then Exit Sub    ' cell c7
    r = Cells(2, 16) + Cells(3, 16) + 3  ' celle p2 e p3
   
    ActiveSheet.ChartObjects("Grafico 14").Visible = True
    ActiveSheet.ChartObjects("Grafico 14").Activate

    '>>>Da qui in avanti e' modificato:
    '--in col BD ci sono i valori--
    Dim xArr(), yArr() As Single, maxXY As Long, cXY, rFatt As Single, iInd As Long
    maxXY = 14          '<<< Il numero max di valori da visualizzare
    cXY = Application.WorksheetFunction.Count(Sheets("diario1").Range("BB7").Resize(1000, 1))
    If cXY > maxXY Then
        rFatt = cXY / maxXY
    Else
        rFatt = 1
    End If
    ReDim xArr(0 To 1000)
    ReDim yArr(0 To 1000)
    For i = 0 To cXY - 1 Step rFatt
        xArr(iInd) = Sheets("diario1").Range("BC7").Offset(i, 0)
        yArr(iInd) = Sheets("diario1").Range("BD7").Offset(i, 0)
        iInd = iInd + 1
    Next i
    ReDim Preserve xArr(0 To iInd - 1)
    ReDim Preserve yArr(0 To iInd - 1)
    ActiveChart.SeriesCollection(1).Values = yArr
    ActiveChart.SeriesCollection(1).XValues = xArr
    '    ActiveChart.SeriesCollection(1).Values = "='diario1'!$bd$7:$bd$" & r + 3  '3 numero da variare secondo i casi
    '    ActiveChart.SeriesCollection(1).XValues = "='diario1'!$bb$7:$bc$15" & r + 3
    '<<< FINE MODIFICHE
    Cells(1, 1).Select
    gg = 1
Else
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 10")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Graf. Vedi"
    ActiveSheet.ChartObjects("Grafico 14").Visible = False
    Cells(1, 1).Select
    gg = 0
End If

Range("a20").Select
End Sub


Ciao

[raimea]

Ottimo !

tutto ok

Grazie